module Halogen.VDom.Utils where

import Data.Map.Strict qualified as M
import HPrelude

{-# SPECIALIZE diffWithIxE ::
  [a]
  -> [b]
  -> (Int -> a -> b -> IO (Maybe c))
  -> (Int -> a -> IO (Maybe c))
  -> (Int -> b -> IO (Maybe c))
  -> IO [c]
  #-}
diffWithIxE :: (Monad m) => [b] -> [c] -> (Int -> b -> c -> m (Maybe d)) -> (Int -> b -> m (Maybe d)) -> (Int -> c -> m (Maybe d)) -> m [d]
diffWithIxE :: forall (m :: * -> *) b c d.
Monad m =>
[b]
-> [c]
-> (Int -> b -> c -> m (Maybe d))
-> (Int -> b -> m (Maybe d))
-> (Int -> c -> m (Maybe d))
-> m [d]
diffWithIxE [b]
u [c]
v Int -> b -> c -> m (Maybe d)
onThese Int -> b -> m (Maybe d)
onThis Int -> c -> m (Maybe d)
onThat = [d] -> [d]
forall a. [a] -> [a]
reverse ([d] -> [d]) -> ([Maybe d] -> [d]) -> [Maybe d] -> [d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe d] -> [d]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe d] -> [d]) -> m [Maybe d] -> m [d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [b] -> [c] -> [Maybe d] -> m [Maybe d]
go Int
0 [b]
u [c]
v []
  where
    go :: Int -> [b] -> [c] -> [Maybe d] -> m [Maybe d]
go Int
_ [] [] [Maybe d]
acc = [Maybe d] -> m [Maybe d]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Maybe d]
acc
    go Int
i (b
x : [b]
xs) [] [Maybe d]
acc = do
      m (Maybe d) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe d) -> m ()) -> m (Maybe d) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> b -> m (Maybe d)
onThis Int
i b
x
      Int -> [b] -> [c] -> [Maybe d] -> m [Maybe d]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [b]
xs [] [Maybe d]
acc
    go Int
i [] (c
y : [c]
ys) [Maybe d]
acc = do
      val <- Int -> c -> m (Maybe d)
onThat Int
i c
y
      go (i + 1) [] ys (val : acc)
    go Int
i (b
x : [b]
xs) (c
y : [c]
ys) [Maybe d]
acc = do
      val <- Int -> b -> c -> m (Maybe d)
onThese Int
i b
x c
y
      go (i + 1) xs ys (val : acc)

{-# SPECIALIZE diffWithKeyAndIxE ::
  Map Text a
  -> [b]
  -> (b -> Text)
  -> (Text -> Int -> a -> b -> IO c)
  -> (Text -> a -> IO d)
  -> (Text -> Int -> b -> IO c)
  -> IO (Map Text c)
  #-}
diffWithKeyAndIxE
  :: (Monad m)
  => Map Text a
  -> [b]
  -> (b -> Text)
  -> (Text -> Int -> a -> b -> m c)
  -> (Text -> a -> m d)
  -> (Text -> Int -> b -> m c)
  -> m (Map Text c)
diffWithKeyAndIxE :: forall (m :: * -> *) a b c d.
Monad m =>
Map Text a
-> [b]
-> (b -> Text)
-> (Text -> Int -> a -> b -> m c)
-> (Text -> a -> m d)
-> (Text -> Int -> b -> m c)
-> m (Map Text c)
diffWithKeyAndIxE Map Text a
o1 [b]
as b -> Text
fk Text -> Int -> a -> b -> m c
f1 Text -> a -> m d
f2 Text -> Int -> b -> m c
f3 = do
  o2 <- (Map Text c -> (Int, b) -> m (Map Text c))
-> Map Text c -> [(Int, b)] -> m (Map Text c)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Text c -> (Int, b) -> m (Map Text c)
go Map Text c
forall k a. Map k a
M.empty ([Int] -> [b] -> [(Int, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [b]
as)
  traverse_ (uncurry f2) (M.toAscList (M.difference o1 o2))
  pure o2
  where
    go :: Map Text c -> (Int, b) -> m (Map Text c)
go Map Text c
acc (Int
i, b
a) = do
      let k :: Text
k = b -> Text
fk b
a
      val <- case Text -> Map Text a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k Map Text a
o1 of
        Just a
v -> Text -> Int -> a -> b -> m c
f1 Text
k Int
i a
v b
a
        Maybe a
Nothing -> Text -> Int -> b -> m c
f3 Text
k Int
i b
a
      pure $ M.insert k val acc

{-# SPECIALIZE strMapWithIxE ::
  [a]
  -> (a -> Text)
  -> (Text -> Int -> a -> IO b)
  -> IO (Map Text b)
  #-}
strMapWithIxE :: (Monad m) => [a] -> (a -> Text) -> (Text -> Int -> a -> m b) -> m (Map Text b)
strMapWithIxE :: forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> Text) -> (Text -> Int -> a -> m b) -> m (Map Text b)
strMapWithIxE = [(Int, a)]
-> (a -> Text) -> (Text -> Int -> a -> m b) -> m (Map Text b)
forall (m :: * -> *) a b.
Monad m =>
[(Int, a)]
-> (a -> Text) -> (Text -> Int -> a -> m b) -> m (Map Text b)
strMapWithIxE' ([(Int, a)]
 -> (a -> Text) -> (Text -> Int -> a -> m b) -> m (Map Text b))
-> ([a] -> [(Int, a)])
-> [a]
-> (a -> Text)
-> (Text -> Int -> a -> m b)
-> m (Map Text b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..]
  where
    strMapWithIxE' :: (Monad m) => [(Int, a)] -> (a -> Text) -> (Text -> Int -> a -> m b) -> m (Map Text b)
    strMapWithIxE' :: forall (m :: * -> *) a b.
Monad m =>
[(Int, a)]
-> (a -> Text) -> (Text -> Int -> a -> m b) -> m (Map Text b)
strMapWithIxE' [] a -> Text
_ Text -> Int -> a -> m b
_ = Map Text b -> m (Map Text b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text b
forall a. Monoid a => a
mempty
    strMapWithIxE' ((Int
i, a
x) : [(Int, a)]
xs) a -> Text
f Text -> Int -> a -> m b
g = do
      val <- Text -> Int -> a -> m b
g (a -> Text
f a
x) Int
i a
x
      m <- strMapWithIxE' xs f g
      pure $ M.insert (f x) val m