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

-- | Extensions to Aeson parsing of objects. This module is intended
-- for internal use by Pantry and Stack only. The intention is to
-- fully remove this module in the future. /DO NOT RELY ON IT/.
module Pantry.Internal.AesonExtended (
    module Export
  -- * Extended failure messages
  , (.:)
  , (.:?)
  -- * JSON Parser that emits warnings
  , JSONWarning (..)
  , WarningParser
  , WithJSONWarnings (..)
  , withObjectWarnings
  , jsonSubWarnings
  , jsonSubWarningsT
  , jsonSubWarningsTT
  , logJSONWarnings
  , noJSONWarnings
  , tellJSONField
  , unWarningParser
  , (..:)
  , (...:)
  , (..:?)
  , (...:?)
  , (..!=)
  ) where

import Control.Monad.Trans.Writer.Strict (WriterT, mapWriterT, runWriterT, tell)
import Data.Aeson as Export hiding ((.:), (.:?))
import qualified Data.Aeson as A
import Data.Aeson.Types hiding ((.:), (.:?))
import qualified Data.HashMap.Strict as HashMap
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)

-- | Extends @.:@ warning to include field name.
(.:) :: FromJSON a => Object -> Text -> Parser 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 -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
p)
{-# INLINE (.:) #-}

-- | Extends @.:?@ warning to include field name.
(.:?) :: FromJSON a => Object -> Text -> Parser (Maybe 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 -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
p)
{-# INLINE (.:?) #-}

-- | 'WarningParser' version of @.:@.
(..:)
    :: FromJSON a
    => Object -> Text -> WarningParser a
Object
o ..: :: Object -> Text -> WarningParser a
..: Text
k = Text -> WarningParser ()
tellJSONField Text
k WarningParser () -> WarningParser a -> WarningParser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a -> WarningParser 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 ..:? :: Object -> Text -> WarningParser (Maybe a)
..:? Text
k = Text -> WarningParser ()
tellJSONField Text
k WarningParser ()
-> WarningParser (Maybe a) -> WarningParser (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Maybe a) -> WarningParser (Maybe 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 ..!= :: 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 (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 (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 (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)

presentCount :: Object -> [Text] -> Int
presentCount :: Object -> [Text] -> Int
presentCount Object
o [Text]
ss = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> ([Text] -> [Text]) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
x -> Text -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
x Object
o) ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ [Text]
ss

-- | Synonym version of @..:@.
(...:) :: FromJSON a => Object -> [Text] -> WarningParser a
Object
_ ...: :: Object -> [Text] -> WarningParser a
...: [] = String -> WarningParser 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]
_) = WarningParser a
apply
    where pc :: Int
pc = Object -> [Text] -> Int
presentCount Object
o [Text]
ss
          apply :: WarningParser a
apply | Int
pc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = String -> WarningParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser a) -> String -> WarningParser 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"
                | Int
pc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
1   = String -> WarningParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser a) -> String -> WarningParser 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"
                | Bool
otherwise = [WarningParser a] -> WarningParser a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([WarningParser a] -> WarningParser a)
-> [WarningParser a] -> WarningParser a
forall a b. (a -> b) -> a -> b
$ (Text -> WarningParser a) -> [Text] -> [WarningParser a]
forall a b. (a -> b) -> [a] -> [b]
map (Object
oObject -> Text -> WarningParser a
forall a. FromJSON a => Object -> Text -> WarningParser a
..:) [Text]
ss

-- | Synonym version of @..:?@.
(...:?) :: FromJSON a => Object -> [Text] -> WarningParser (Maybe a)
Object
_ ...:? :: Object -> [Text] -> WarningParser (Maybe a)
...:? [] = String -> WarningParser (Maybe 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]
_) = WarningParser (Maybe a)
apply
    where pc :: Int
pc = Object -> [Text] -> Int
presentCount Object
o [Text]
ss
          apply :: WarningParser (Maybe a)
apply | Int
pc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = Maybe a -> WarningParser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                | Int
pc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
1   = String -> WarningParser (Maybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Maybe a))
-> String -> WarningParser (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"
                | Bool
otherwise = [WarningParser (Maybe a)] -> WarningParser (Maybe a)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([WarningParser (Maybe a)] -> WarningParser (Maybe a))
-> [WarningParser (Maybe a)] -> WarningParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Text -> WarningParser (Maybe a))
-> [Text] -> [WarningParser (Maybe a)]
forall a b. (a -> b) -> [a] -> [b]
map (Object
oObject -> Text -> WarningParser (Maybe a)
forall a. FromJSON a => Object -> Text -> WarningParser a
..:) [Text]
ss

-- | Tell 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 Text
wpmExpectedFields = Text -> Set Text
forall a. a -> Set a
Set.singleton Text
key})

-- | 'WarningParser' version of 'withObject'.
withObjectWarnings :: String
                   -> (Object -> WarningParser a)
                   -> Value
                   -> Parser (WithJSONWarnings a)
withObjectWarnings :: 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 (Object -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys Object
obj))
                             (WarningParserMonoid -> Set Text
wpmExpectedFields WarningParserMonoid
w))
            WithJSONWarnings a -> Parser (WithJSONWarnings a)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Log JSON warnings.
logJSONWarnings
    :: (MonadReader env m, HasLogFunc env, HasCallStack, MonadIO m)
    => FilePath -> [JSONWarning] -> m ()
logJSONWarnings :: 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 :: 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 :: [JSONWarning]
wpmWarnings = [JSONWarning]
warnings
         })
    a -> WarningParser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Handle warnings in a @Traversable@ of sub-objects.
jsonSubWarningsT
    :: Traversable t
    => WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT :: WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT WarningParser (t (WithJSONWarnings a))
f =
    (WithJSONWarnings a -> WriterT WarningParserMonoid Parser a)
-> t (WithJSONWarnings a) -> WarningParser (t a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, 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 (m :: * -> *) a. Monad m => a -> m a
return) (t (WithJSONWarnings a) -> WarningParser (t a))
-> WarningParser (t (WithJSONWarnings a)) -> WarningParser (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 :: 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)) -> WarningParser (u (t a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 (m :: * -> *) a. Monad m => a -> m a
return) (u (t (WithJSONWarnings a)) -> WarningParser (u (t a)))
-> WarningParser (u (t (WithJSONWarnings a)))
-> WarningParser (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 :: a -> WithJSONWarnings a
noJSONWarnings a
v = a -> [JSONWarning] -> WithJSONWarnings a
forall a. a -> [JSONWarning] -> WithJSONWarnings a
WithJSONWarnings a
v []

-- | 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
$cto :: forall x. Rep WarningParserMonoid x -> WarningParserMonoid
$cfrom :: forall x. WarningParserMonoid -> Rep WarningParserMonoid x
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 :: [JSONWarning]
wpmWarnings = [String -> JSONWarning
forall a. IsString a => String -> a
fromString String
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
/= :: WithJSONWarnings a -> WithJSONWarnings a -> Bool
$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
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
$cto :: forall a x. Rep (WithJSONWarnings a) x -> WithJSONWarnings a
$cfrom :: forall a x. WithJSONWarnings a -> Rep (WithJSONWarnings a) x
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
showList :: [WithJSONWarnings a] -> String -> String
$cshowList :: forall a. Show a => [WithJSONWarnings a] -> String -> String
show :: WithJSONWarnings a -> String
$cshow :: forall a. Show a => WithJSONWarnings a -> String
showsPrec :: Int -> WithJSONWarnings a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> WithJSONWarnings a -> String -> String
Show)
instance Functor WithJSONWarnings where
    fmap :: (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
/= :: JSONWarning -> JSONWarning -> Bool
$c/= :: JSONWarning -> JSONWarning -> Bool
== :: JSONWarning -> JSONWarning -> Bool
$c== :: 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