-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

-- | Optional advisory fields share lenient Aeson decoding across ecosystems.
module Ecluse.Core.Json.Lenient (
    lenientOptional,
    typeMismatchOneOf,
    valueKind,
) where

import Data.Aeson (
    FromJSON (parseJSON),
    Object,
    Value (Array, Bool, Null, Number, Object, String),
    (.:?),
 )
import Data.Aeson.Key (Key)
import Data.Aeson.Types (Parser, parseMaybe)

{- | Decode an optional field __leniently__: absent, @null@, and undecodable yield 'Nothing', so
one poisoned value cannot deny the document. For __advisory__ fields only, never a load-bearing one.
-}
lenientOptional :: (FromJSON a, NFData a) => Object -> Key -> Parser (Maybe a)
lenientOptional :: forall a.
(FromJSON a, NFData a) =>
Object -> Key -> Parser (Maybe a)
lenientOptional Object
o Key
k = do
    mv <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
k -- Parser (Maybe Value): a present junk value still arrives here
    -- Evaluated in full, so a retained field holds none of the decoder's state.
    pure $ case mv >>= parseMaybe parseJSON of
        Just a
value -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. NFData a => (a -> b) -> a -> b
$!! a
value
        Maybe a
Nothing -> Maybe a
forall a. Maybe a
Nothing

{- | Fail a lenient decoder with a message that names the accepted shapes and the JSON kind
it found.
-}
typeMismatchOneOf :: String -> Value -> Parser a
typeMismatchOneOf :: forall a. String -> Value -> Parser a
typeMismatchOneOf String
expected Value
actual =
    String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
expected String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", but encountered " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
valueKind Value
actual)

-- | A short description of a JSON value's kind, for parse-error messages.
valueKind :: Value -> String
valueKind :: Value -> String
valueKind = \case
    Object{} -> String
"an object"
    String{} -> String
"a string"
    Array{} -> String
"an array"
    Number{} -> String
"a number"
    Bool{} -> String
"a boolean"
    Value
Null -> String
"null"