module Data.JLD.Util (
    valueContains,
    valueContainsAny,
    valueIsTrue,
    valueIsString,
    valueIsArray,
    valueIsNotArray,
    valueIsEmptyArray,
    valueIsScalar,
    valueToString,
    valueIsNotString,
    valueIsNotNull,
    flattenSingletonArray,
    valueToArray,
    allStrings,
    ifindM,
    getMapDefault,
    mapAddValue,
) where

import Data.JLD.Prelude

import Data.Aeson (Array, Key, Object, Value (..))
import Data.Aeson.Key qualified as K (fromText)
import Data.Aeson.KeyMap qualified as KM (insert, lookup, member)
import Data.Foldable qualified as F (Foldable (..), elem)
import Data.Foldable.WithIndex (FoldableWithIndex (..), ifoldlM)
import Data.Vector (Vector)
import Data.Vector qualified as V (fromList, null, singleton, snoc, uncons)

valueContains :: Text -> Value -> Bool
valueContains text = \case
    String s -> s == text
    Array a -> elem (String text) a
    Object o -> KM.member (K.fromText text) o
    _ -> False

valueContainsAny :: (Foldable f, Functor f) => f Text -> Value -> Bool
valueContainsAny texts = \case
    String s -> s `F.elem` texts
    Array a -> any (`elem` a) <| String <$> texts
    Object o -> any (\text -> KM.member (K.fromText text) o) texts
    _ -> False

valueIsTrue :: Value -> Bool
valueIsTrue (Bool True) = True
valueIsTrue _ = False

valueIsString :: Value -> Bool
valueIsString (String _) = True
valueIsString _ = False

valueIsNotString :: Value -> Bool
valueIsNotString = valueIsString .> not

valueIsArray :: Value -> Bool
valueIsArray (Array _) = True
valueIsArray _ = False

valueIsNotArray :: Value -> Bool
valueIsNotArray = valueIsArray .> not

valueIsEmptyArray :: Value -> Bool
valueIsEmptyArray (Array a) = V.null a
valueIsEmptyArray _ = False

valueIsScalar :: Value -> Bool
valueIsScalar = \case
    String _ -> True
    Number _ -> True
    Bool _ -> True
    _ -> False

valueToString :: Value -> Maybe Text
valueToString (String s) = Just s
valueToString _ = Nothing

valueIsNotNull :: Value -> Bool
valueIsNotNull Null = False
valueIsNotNull _ = True

flattenSingletonArray :: Value -> Value
flattenSingletonArray = \case
    Array (V.uncons -> Just (value, V.null -> True)) -> value
    value -> value

valueToArray :: Value -> Array
valueToArray = \case
    Array a -> a
    value -> V.singleton value

allStrings :: Array -> Maybe (Vector Text)
allStrings = foldl' go (Just mempty)
  where
    go :: Maybe (Vector Text) -> Value -> Maybe (Vector Text)
    go (Just a) (String s) = Just <| V.snoc a s
    go _ _ = Nothing

ifindM :: (FoldableWithIndex i f, Monad m) => (i -> a -> m Bool) -> f a -> m (Maybe a)
ifindM p = ifoldlM (\i r x -> p i x <&> bool r (Just x)) Nothing

getMapDefault :: Key -> Object -> Object
getMapDefault key obj = case KM.lookup key obj of
    Just (Object o) -> o
    _ -> mempty

mapAddValue :: Key -> Value -> Bool -> Object -> Object
mapAddValue key value True object = mapAddValue key value False <| KM.insert key (Array array) object
  where
    array = case KM.lookup key object of
        Just (Array a) -> a
        Just original -> V.singleton original
        Nothing -> mempty
mapAddValue key (Array value) False object = foldl' (\o v -> mapAddValue key v False o) object value
mapAddValue key value False object = case KM.lookup key object of
    Just (Array a) -> KM.insert key (Array <| V.snoc a value) object
    Just original -> KM.insert key (Array <| V.fromList [original, value]) object
    Nothing -> KM.insert key value object