module Ondim.Targets.Aeson.Instances
  ( AesonNode (..)
  , nodeToValue
  , nodeFromValue
  , renderWhiskers
  )
  where

import Data.Aeson
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Bitraversable (bimapM)
import Data.List qualified as L
import Data.Scientific (Scientific)
import Data.Text qualified as T
import Data.Typeable (eqT, (:~:) (..))
import Ondim
import Ondim.Advanced
import Ondim.Debug
import Ondim.Targets.Whiskers (parseWhiskers)
import Ondim.Targets.Whiskers.Instances (WNode (Textual), renderWhiskers)
import Relude.Extra.Map qualified as M

data AesonNode
  = Array' ![AesonNode]
  | Object' ![(Text, AesonNode)]
  | String' ![WNode]
  | Number' !Scientific
  | Bool' !Bool
  | Null'

nodeToValue :: AesonNode -> Value
nodeToValue :: AesonNode -> Value
nodeToValue = \case
  Array' [AesonNode]
l -> Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList ([Item Array] -> Array) -> [Item Array] -> Array
forall a b. (a -> b) -> a -> b
$ (AesonNode -> Value) -> [AesonNode] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map AesonNode -> Value
nodeToValue [AesonNode]
l
  Object' [(Text, AesonNode)]
m -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ ((Text, AesonNode) -> (Key, Value))
-> [(Text, AesonNode)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Key)
-> (AesonNode -> Value) -> (Text, AesonNode) -> (Key, Value)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> Key
K.fromText AesonNode -> Value
nodeToValue) ([(Text, AesonNode)] -> [(Key, Value)])
-> [(Text, AesonNode)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ [(Text, AesonNode)] -> [(Text, AesonNode)]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
M.toPairs [(Text, AesonNode)]
m
  String' [WNode]
t -> Text -> Value
String ([WNode] -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers [WNode]
t)
  Number' Scientific
n -> Scientific -> Value
Number Scientific
n
  Bool' Bool
b -> Bool -> Value
Bool Bool
b
  AesonNode
Null' -> Value
Null

nodeFromValue :: Value -> Either String AesonNode
nodeFromValue :: Value -> Either String AesonNode
nodeFromValue = \case
  Array Array
l -> [AesonNode] -> AesonNode
Array' ([AesonNode] -> AesonNode)
-> Either String [AesonNode] -> Either String AesonNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Either String AesonNode)
-> [Value] -> Either String [AesonNode]
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) -> [a] -> m [b]
mapM Value -> Either String AesonNode
nodeFromValue (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
l)
  Object Object
m -> [(Text, AesonNode)] -> AesonNode
Object' ([(Text, AesonNode)] -> AesonNode)
-> Either String [(Text, AesonNode)] -> Either String AesonNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Key, Value) -> Either String (Text, AesonNode))
-> [(Key, Value)] -> Either String [(Text, AesonNode)]
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) -> [a] -> m [b]
mapM ((Key -> Either String Text)
-> (Value -> Either String AesonNode)
-> (Key, Value)
-> Either String (Text, AesonNode)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bimapM (Text -> Either String Text
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either String Text)
-> (Key -> Text) -> Key -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
K.toText) Value -> Either String AesonNode
nodeFromValue) (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
m)
  String Text
t -> [WNode] -> AesonNode
String' ([WNode] -> AesonNode)
-> Either String [WNode] -> Either String AesonNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, Text) -> String -> Text -> Either String [WNode]
parseWhiskers (Text
"${", Text
"}") String
"" Text
t
  Number Scientific
n -> AesonNode -> Either String AesonNode
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (AesonNode -> Either String AesonNode)
-> AesonNode -> Either String AesonNode
forall a b. (a -> b) -> a -> b
$ Scientific -> AesonNode
Number' Scientific
n
  Bool Bool
b -> AesonNode -> Either String AesonNode
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (AesonNode -> Either String AesonNode)
-> AesonNode -> Either String AesonNode
forall a b. (a -> b) -> a -> b
$ Bool -> AesonNode
Bool' Bool
b
  Value
Null -> AesonNode -> Either String AesonNode
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return AesonNode
Null'

instance Expansible AesonNode where
  expandSubs :: forall s. AesonNode -> Ondim s AesonNode
expandSubs = \case
    Array' [AesonNode]
a -> [AesonNode] -> AesonNode
Array' ([AesonNode] -> AesonNode)
-> Ondim s [AesonNode] -> Ondim s AesonNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AesonNode] -> Ondim s [AesonNode]
forall s. [AesonNode] -> Ondim s [AesonNode]
forall t s. Expansible t => t -> Ondim s t
expandSubs [AesonNode]
a
    Object' [(Text, AesonNode)]
m -> [(Text, AesonNode)] -> AesonNode
Object' ([(Text, AesonNode)] -> AesonNode)
-> Ondim s [(Text, AesonNode)] -> Ondim s AesonNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, AesonNode) -> Ondim s (Maybe (Text, AesonNode)))
-> [(Text, AesonNode)] -> Ondim s [(Text, AesonNode)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (Text, AesonNode) -> Ondim s (Maybe (Text, AesonNode))
forall {a} {s}.
Expansible a =>
(Text, a) -> Ondim s (Maybe (Text, a))
go [(Text, AesonNode)]
m
      where
        go :: (Text, a) -> Ondim s (Maybe (Text, a))
go (Text
k, a
v)
          | Just (Text
k', Char
'?') <- Text -> Maybe (Text, Char)
T.unsnoc Text
k =
              ((Text, a) -> Maybe (Text, a)
forall a. a -> Maybe a
Just ((Text, a) -> Maybe (Text, a))
-> (a -> (Text, a)) -> a -> Maybe (Text, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
k',) (a -> Maybe (Text, a)) -> Ondim s a -> Ondim s (Maybe (Text, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Ondim s a
forall s. a -> Ondim s a
forall t s. Expansible t => t -> Ondim s t
expandSubs a
v)
                Ondim s (Maybe (Text, a))
-> (OndimFailure
    -> Text -> SomeTypeRep -> TraceData -> Ondim s (Maybe (Text, a)))
-> Ondim s (Maybe (Text, a))
forall s a.
Ondim s a
-> (OndimFailure -> Text -> SomeTypeRep -> TraceData -> Ondim s a)
-> Ondim s a
`catchFailure` \OndimFailure
_ Text
_ SomeTypeRep
_ TraceData
_ -> Maybe (Text, a) -> Ondim s (Maybe (Text, a))
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, a)
forall a. Maybe a
Nothing
          | Bool
otherwise = (Text, a) -> Maybe (Text, a)
forall a. a -> Maybe a
Just ((Text, a) -> Maybe (Text, a))
-> (a -> (Text, a)) -> a -> Maybe (Text, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
k,) (a -> Maybe (Text, a)) -> Ondim s a -> Ondim s (Maybe (Text, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Ondim s a
forall s. a -> Ondim s a
forall t s. Expansible t => t -> Ondim s t
expandSubs a
v
    String' [WNode]
t -> [WNode] -> AesonNode
String' ([WNode] -> AesonNode) -> Ondim s [WNode] -> Ondim s AesonNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WNode] -> Ondim s [WNode]
forall s. [WNode] -> Ondim s [WNode]
forall t s. Expansible t => t -> Ondim s t
expandSubs [WNode]
t
    AesonNode
x -> AesonNode -> Ondim s AesonNode
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return AesonNode
x

instance OndimNode AesonNode where
  identify :: AesonNode -> Maybe Text
identify = \case
    (Object' [(Text, AesonNode)]
o)
      | Just (String' [WNode]
name) <- Text -> [(Text, AesonNode)] -> Maybe AesonNode
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
"$" [(Text, AesonNode)]
o -> Text -> Maybe Text
forall a. a -> Maybe a
Just ([WNode] -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers [WNode]
name)
    AesonNode
_ -> Maybe Text
forall a. Maybe a
Nothing
  children :: AesonNode -> [AesonNode]
children = \case
    (Object' [(Text, AesonNode)]
o)
      | Just (Array' [AesonNode]
a) <- Text -> [(Text, AesonNode)] -> Maybe AesonNode
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
"children" [(Text, AesonNode)]
o -> [AesonNode]
a
    AesonNode
_ -> [AesonNode]
forall a. Monoid a => a
mempty
  attributes :: forall s. AesonNode -> Ondim s [(Text, Text)]
attributes (Object' [(Text, AesonNode)]
o) = ((Text, AesonNode) -> Ondim s (Maybe (Text, Text)))
-> [(Text, AesonNode)] -> Ondim s [(Text, Text)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (Text, AesonNode) -> Ondim s (Maybe (Text, Text))
forall {a} {s}. (a, AesonNode) -> Ondim s (Maybe (a, Text))
go ([(Text, AesonNode)] -> Ondim s [(Text, Text)])
-> [(Text, AesonNode)] -> Ondim s [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ [(Text, AesonNode)] -> [(Text, AesonNode)]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
M.toPairs [(Text, AesonNode)]
o
    where
      go :: (a, AesonNode) -> Ondim s (Maybe (a, Text))
go (a
k, AesonNode
v)
        | String' [WNode]
t <- AesonNode
v = do
            t' <- [WNode] -> Ondim s [WNode]
forall s. [WNode] -> Ondim s [WNode]
forall t s. Expansible t => t -> Ondim s t
expandSubs [WNode]
t
            return $ Just (k, renderWhiskers t')
        | Bool
otherwise = Maybe (a, Text) -> Ondim s (Maybe (a, Text))
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, Text)
forall a. Maybe a
Nothing
  attributes AesonNode
_ = [(Text, Text)] -> Ondim s [(Text, Text)]
forall a. a -> Ondim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  castFrom :: forall t. (Typeable t) => Maybe (t -> [AesonNode])
  castFrom :: forall t. Typeable t => Maybe (t -> [AesonNode])
castFrom
    | Just t :~: Text
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @t @Text = (t -> [AesonNode]) -> Maybe (t -> [AesonNode])
forall a. a -> Maybe a
Just ((t -> [AesonNode]) -> Maybe (t -> [AesonNode]))
-> (t -> [AesonNode]) -> Maybe (t -> [AesonNode])
forall a b. (a -> b) -> a -> b
$ OneItem [AesonNode] -> [AesonNode]
AesonNode -> [AesonNode]
forall x. One x => OneItem x -> x
one (AesonNode -> [AesonNode]) -> (t -> AesonNode) -> t -> [AesonNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WNode] -> AesonNode
String' ([WNode] -> AesonNode) -> (t -> [WNode]) -> t -> AesonNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WNode -> [WNode]
OneItem [WNode] -> [WNode]
forall x. One x => OneItem x -> x
one (WNode -> [WNode]) -> (t -> WNode) -> t -> [WNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> WNode
Text -> WNode
Textual
    | Bool
otherwise = Maybe (t -> [AesonNode])
forall a. Maybe a
Nothing
  nodeAsText :: Maybe (AesonNode -> Text)
nodeAsText = (AesonNode -> Text) -> Maybe (AesonNode -> Text)
forall a. a -> Maybe a
Just \case
    String' [WNode]
t -> [WNode] -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers [WNode]
t
    AesonNode
_notString -> Text
forall a. Monoid a => a
mempty
  renderNode :: Maybe (AesonNode -> LByteString)
renderNode = (AesonNode -> LByteString) -> Maybe (AesonNode -> LByteString)
forall a. a -> Maybe a
Just (Value -> LByteString
forall a. ToJSON a => a -> LByteString
encode (Value -> LByteString)
-> (AesonNode -> Value) -> AesonNode -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonNode -> Value
nodeToValue)