{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : Concoct.View.Rebuild
-- Copyright   : (c) Matt Hunzinger, 2026
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : matt@hunzinger.me
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Concoct.View.Rebuild (Rebuild (..), runRebuild) where

import Concoct.View.Build
import Concoct.View.Internal
import Concoct.View.Skip
import Concoct.View.Unmount
import Control.Monad
import Control.Monad.State

newtype Rebuild m a = Rebuild {forall (m :: * -> *) a. Rebuild m a -> StateT ViewState m a
unRebuild :: StateT ViewState m a}
  deriving ((forall a b. (a -> b) -> Rebuild m a -> Rebuild m b)
-> (forall a b. a -> Rebuild m b -> Rebuild m a)
-> Functor (Rebuild m)
forall a b. a -> Rebuild m b -> Rebuild m a
forall a b. (a -> b) -> Rebuild m a -> Rebuild m b
forall (m :: * -> *) a b.
Functor m =>
a -> Rebuild m b -> Rebuild m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Rebuild m a -> Rebuild m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Rebuild m a -> Rebuild m b
fmap :: forall a b. (a -> b) -> Rebuild m a -> Rebuild m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Rebuild m b -> Rebuild m a
<$ :: forall a b. a -> Rebuild m b -> Rebuild m a
Functor, Functor (Rebuild m)
Functor (Rebuild m) =>
(forall a. a -> Rebuild m a)
-> (forall a b. Rebuild m (a -> b) -> Rebuild m a -> Rebuild m b)
-> (forall a b c.
    (a -> b -> c) -> Rebuild m a -> Rebuild m b -> Rebuild m c)
-> (forall a b. Rebuild m a -> Rebuild m b -> Rebuild m b)
-> (forall a b. Rebuild m a -> Rebuild m b -> Rebuild m a)
-> Applicative (Rebuild m)
forall a. a -> Rebuild m a
forall a b. Rebuild m a -> Rebuild m b -> Rebuild m a
forall a b. Rebuild m a -> Rebuild m b -> Rebuild m b
forall a b. Rebuild m (a -> b) -> Rebuild m a -> Rebuild m b
forall a b c.
(a -> b -> c) -> Rebuild m a -> Rebuild m b -> Rebuild m c
forall (m :: * -> *). Monad m => Functor (Rebuild m)
forall (m :: * -> *) a. Monad m => a -> Rebuild m a
forall (m :: * -> *) a b.
Monad m =>
Rebuild m a -> Rebuild m b -> Rebuild m a
forall (m :: * -> *) a b.
Monad m =>
Rebuild m a -> Rebuild m b -> Rebuild m b
forall (m :: * -> *) a b.
Monad m =>
Rebuild m (a -> b) -> Rebuild m a -> Rebuild m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Rebuild m a -> Rebuild m b -> Rebuild m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> Rebuild m a
pure :: forall a. a -> Rebuild m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
Rebuild m (a -> b) -> Rebuild m a -> Rebuild m b
<*> :: forall a b. Rebuild m (a -> b) -> Rebuild m a -> Rebuild m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Rebuild m a -> Rebuild m b -> Rebuild m c
liftA2 :: forall a b c.
(a -> b -> c) -> Rebuild m a -> Rebuild m b -> Rebuild m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
Rebuild m a -> Rebuild m b -> Rebuild m b
*> :: forall a b. Rebuild m a -> Rebuild m b -> Rebuild m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
Rebuild m a -> Rebuild m b -> Rebuild m a
<* :: forall a b. Rebuild m a -> Rebuild m b -> Rebuild m a
Applicative, Applicative (Rebuild m)
Applicative (Rebuild m) =>
(forall a b. Rebuild m a -> (a -> Rebuild m b) -> Rebuild m b)
-> (forall a b. Rebuild m a -> Rebuild m b -> Rebuild m b)
-> (forall a. a -> Rebuild m a)
-> Monad (Rebuild m)
forall a. a -> Rebuild m a
forall a b. Rebuild m a -> Rebuild m b -> Rebuild m b
forall a b. Rebuild m a -> (a -> Rebuild m b) -> Rebuild m b
forall (m :: * -> *). Monad m => Applicative (Rebuild m)
forall (m :: * -> *) a. Monad m => a -> Rebuild m a
forall (m :: * -> *) a b.
Monad m =>
Rebuild m a -> Rebuild m b -> Rebuild m b
forall (m :: * -> *) a b.
Monad m =>
Rebuild m a -> (a -> Rebuild m b) -> Rebuild m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Rebuild m a -> (a -> Rebuild m b) -> Rebuild m b
>>= :: forall a b. Rebuild m a -> (a -> Rebuild m b) -> Rebuild m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Rebuild m a -> Rebuild m b -> Rebuild m b
>> :: forall a b. Rebuild m a -> Rebuild m b -> Rebuild m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> Rebuild m a
return :: forall a. a -> Rebuild m a
Monad)

instance (MonadIO m) => MonadView m (Rebuild m) where
  useState :: forall a. Typeable a => m a -> Rebuild m (StateRef a)
useState m a
_ = StateT ViewState m (StateRef a) -> Rebuild m (StateRef a)
forall (m :: * -> *) a. StateT ViewState m a -> Rebuild m a
Rebuild (StateT ViewState m (StateRef a) -> Rebuild m (StateRef a))
-> StateT ViewState m (StateRef a) -> Rebuild m (StateRef a)
forall a b. (a -> b) -> a -> b
$ StateT ViewState m (StateRef a)
forall (m :: * -> *) a.
(MonadIO m, Typeable a) =>
StateT ViewState m (StateRef a)
rebuildState
  useRef :: forall a. Typeable a => m a -> Rebuild m (ViewRef a)
useRef m a
_ = StateT ViewState m (ViewRef a) -> Rebuild m (ViewRef a)
forall (m :: * -> *) a. StateT ViewState m a -> Rebuild m a
Rebuild (StateT ViewState m (ViewRef a) -> Rebuild m (ViewRef a))
-> StateT ViewState m (ViewRef a) -> Rebuild m (ViewRef a)
forall a b. (a -> b) -> a -> b
$ StateT ViewState m (ViewRef a)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
StateT ViewState m (ViewRef a)
rebuildRef
  useEffect :: forall d. (Eq d, Typeable d) => m d -> (d -> m ()) -> Rebuild m ()
useEffect m d
deps d -> m ()
f = StateT ViewState m () -> Rebuild m ()
forall (m :: * -> *) a. StateT ViewState m a -> Rebuild m a
Rebuild (StateT ViewState m () -> Rebuild m ())
-> StateT ViewState m () -> Rebuild m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe d
mdep <- (ViewState -> Maybe d) -> StateT ViewState m (Maybe d)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((ViewState -> Maybe d) -> StateT ViewState m (Maybe d))
-> (ViewState -> Maybe d) -> StateT ViewState m (Maybe d)
forall a b. (a -> b) -> a -> b
$ Stack -> Maybe d
forall a. Typeable a => Stack -> Maybe a
peekStack (Stack -> Maybe d) -> (ViewState -> Stack) -> ViewState -> Maybe d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewState -> Stack
viewStack
    case Maybe d
mdep of
      Just d
oldDeps -> do
        d
deps' <- m d -> StateT ViewState m d
forall (m :: * -> *) a. Monad m => m a -> StateT ViewState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
deps
        Bool -> StateT ViewState m () -> StateT ViewState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (d
oldDeps d -> d -> Bool
forall a. Eq a => a -> a -> Bool
/= d
deps') (StateT ViewState m () -> StateT ViewState m ())
-> StateT ViewState m () -> StateT ViewState m ()
forall a b. (a -> b) -> a -> b
$ do
          (ViewState -> ViewState) -> StateT ViewState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ViewState -> ViewState) -> StateT ViewState m ())
-> (ViewState -> ViewState) -> StateT ViewState m ()
forall a b. (a -> b) -> a -> b
$ \ViewState
vs -> ViewState
vs {viewStack = setStack deps' (viewStack vs)}
          m () -> StateT ViewState m ()
forall (m :: * -> *) a. Monad m => m a -> StateT ViewState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT ViewState m ()) -> m () -> StateT ViewState m ()
forall a b. (a -> b) -> a -> b
$ d -> m ()
f d
deps'
      Maybe d
Nothing -> [Char] -> StateT ViewState m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"useEffect: Dependencies not found in stack during rebuild"
  useOnUnmount :: m () -> Rebuild m ()
useOnUnmount m ()
_ = () -> Rebuild m ()
forall a. a -> Rebuild m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  component :: (forall (x :: * -> *). MonadView m x => x ()) -> Rebuild m ()
component forall (x :: * -> *). MonadView m x => x ()
v = StateT ViewState m () -> Rebuild m ()
forall (m :: * -> *) a. StateT ViewState m a -> Rebuild m a
Rebuild (StateT ViewState m () -> Rebuild m ())
-> StateT ViewState m () -> Rebuild m ()
forall a b. (a -> b) -> a -> b
$ (Rebuild m () -> StateT ViewState m ())
-> (forall (x :: * -> *). MonadView m x => x ())
-> StateT ViewState m ()
forall (m :: * -> *) (t :: * -> *) (f :: * -> *).
(MonadIO m, MonadView t f) =>
(f () -> StateT ViewState m ())
-> (forall (x :: * -> *). MonadView t x => x ())
-> StateT ViewState m ()
rebuildComponent Rebuild m () -> StateT ViewState m ()
forall (m :: * -> *) a. Rebuild m a -> StateT ViewState m a
unRebuild x ()
forall (x :: * -> *). MonadView m x => x ()
v
  liftView :: m () -> Rebuild m ()
liftView = StateT ViewState m () -> Rebuild m ()
forall (m :: * -> *) a. StateT ViewState m a -> Rebuild m a
Rebuild (StateT ViewState m () -> Rebuild m ())
-> (m () -> StateT ViewState m ()) -> m () -> Rebuild m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> StateT ViewState m ()
forall (m :: * -> *) a. Monad m => m a -> StateT ViewState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
  switchView :: m Bool
-> (forall (x :: * -> *). MonadView m x => x ())
-> (forall (x :: * -> *). MonadView m x => x ())
-> Rebuild m ()
switchView m Bool
cond forall (x :: * -> *). MonadView m x => x ()
vTrue forall (x :: * -> *). MonadView m x => x ()
vFalse = StateT ViewState m () -> Rebuild m ()
forall (m :: * -> *) a. StateT ViewState m a -> Rebuild m a
Rebuild (StateT ViewState m () -> Rebuild m ())
-> StateT ViewState m () -> Rebuild m ()
forall a b. (a -> b) -> a -> b
$ do
    ViewState
vs <- StateT ViewState m ViewState
forall s (m :: * -> *). MonadState s m => m s
get
    let (Maybe Bool
mcond, Stack
s') = Stack -> (Maybe Bool, Stack)
forall a. Typeable a => Stack -> (Maybe a, Stack)
popStack (ViewState -> Stack
viewStack ViewState
vs)
    case Maybe Bool
mcond of
      Just Bool
oldCond -> do
        Bool
cond' <- m Bool -> StateT ViewState m Bool
forall (m :: * -> *) a. Monad m => m a -> StateT ViewState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
cond
        if Bool
oldCond Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
cond'
          then do
            ViewState -> StateT ViewState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ViewState
vs {viewStack = pushStack cond' s'}
            if Bool
cond' then Rebuild m () -> StateT ViewState m ()
forall (m :: * -> *) a. Rebuild m a -> StateT ViewState m a
unRebuild Rebuild m ()
forall (x :: * -> *). MonadView m x => x ()
vTrue else Rebuild m () -> StateT ViewState m ()
forall (m :: * -> *) a. Rebuild m a -> StateT ViewState m a
unRebuild Rebuild m ()
forall (x :: * -> *). MonadView m x => x ()
vFalse
          else do
            ViewState -> StateT ViewState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ViewState
vs {viewStack = pushStack cond' s'}
            if Bool
oldCond
              then Skip m () -> StateT ViewState m ()
forall (m :: * -> *) a. Skip m a -> StateT ViewState m a
unSkip Skip m ()
forall (x :: * -> *). MonadView m x => x ()
vTrue
              else Skip m () -> StateT ViewState m ()
forall (m :: * -> *) a. Skip m a -> StateT ViewState m a
unSkip Skip m ()
forall (x :: * -> *). MonadView m x => x ()
vFalse
            if Bool
cond'
              then Build m () -> StateT ViewState m ()
forall (m :: * -> *) a. Build m a -> StateT ViewState m a
unBuild Build m ()
forall (x :: * -> *). MonadView m x => x ()
vTrue
              else Build m () -> StateT ViewState m ()
forall (m :: * -> *) a. Build m a -> StateT ViewState m a
unBuild Build m ()
forall (x :: * -> *). MonadView m x => x ()
vFalse
      Maybe Bool
Nothing -> [Char] -> StateT ViewState m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"switchView: Condition not found in stack during rebuild"
  listView :: forall a.
(Typeable a, Eq a) =>
m [a]
-> (a -> forall (x :: * -> *). MonadView m x => x ())
-> Rebuild m ()
listView m [a]
items a -> forall (x :: * -> *). MonadView m x => x ()
f = StateT ViewState m () -> Rebuild m ()
forall (m :: * -> *) a. StateT ViewState m a -> Rebuild m a
Rebuild (StateT ViewState m () -> Rebuild m ())
-> StateT ViewState m () -> Rebuild m ()
forall a b. (a -> b) -> a -> b
$ do
    ViewState
vs <- StateT ViewState m ViewState
forall s (m :: * -> *). MonadState s m => m s
get
    let (Maybe [a]
mOldItems, Stack
s') = Stack -> (Maybe [a], Stack)
forall a. Typeable a => Stack -> (Maybe a, Stack)
popStack (ViewState -> Stack
viewStack ViewState
vs)
    case Maybe [a]
mOldItems of
      Just [a]
oldItems -> do
        [a]
items' <- m [a] -> StateT ViewState m [a]
forall (m :: * -> *) a. Monad m => m a -> StateT ViewState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [a]
items
        ViewState -> StateT ViewState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ViewState
vs {viewStack = pushStack items' s'}
        -- Update shared items
        let common :: [(a, a)]
common = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
oldItems [a]
items'
            oldLen :: Int
oldLen = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
oldItems
            newLen :: Int
newLen = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
items'
        [(a, a)]
-> ((a, a) -> StateT ViewState m ()) -> StateT ViewState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(a, a)]
common (((a, a) -> StateT ViewState m ()) -> StateT ViewState m ())
-> ((a, a) -> StateT ViewState m ()) -> StateT ViewState m ()
forall a b. (a -> b) -> a -> b
$ \(a
old, a
new) ->
          if a
old a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
new
            then Skip m () -> StateT ViewState m ()
forall (m :: * -> *) a. Skip m a -> StateT ViewState m a
unSkip (a -> forall (x :: * -> *). MonadView m x => x ()
f a
old)
            else do
              Skip m () -> StateT ViewState m ()
forall (m :: * -> *) a. Skip m a -> StateT ViewState m a
unSkip (a -> forall (x :: * -> *). MonadView m x => x ()
f a
old)
              Build m () -> StateT ViewState m ()
forall (m :: * -> *) a. Build m a -> StateT ViewState m a
unBuild (a -> forall (x :: * -> *). MonadView m x => x ()
f a
new)
        -- Unmount removed items
        Bool -> StateT ViewState m () -> StateT ViewState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
oldLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
newLen) (StateT ViewState m () -> StateT ViewState m ())
-> StateT ViewState m () -> StateT ViewState m ()
forall a b. (a -> b) -> a -> b
$
          [a] -> (a -> StateT ViewState m ()) -> StateT ViewState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
newLen [a]
oldItems) ((a -> StateT ViewState m ()) -> StateT ViewState m ())
-> (a -> StateT ViewState m ()) -> StateT ViewState m ()
forall a b. (a -> b) -> a -> b
$ \a
old -> do
            ViewState
vs' <- StateT ViewState m ViewState
forall s (m :: * -> *). MonadState s m => m s
get
            (()
_, Stack
stack') <- m ((), Stack) -> StateT ViewState m ((), Stack)
forall (m :: * -> *) a. Monad m => m a -> StateT ViewState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ((), Stack) -> StateT ViewState m ((), Stack))
-> m ((), Stack) -> StateT ViewState m ((), Stack)
forall a b. (a -> b) -> a -> b
$ Unmount m () -> Stack -> m ((), Stack)
forall (m :: * -> *) a.
MonadIO m =>
Unmount m a -> Stack -> m (a, Stack)
runUnmount (a -> forall (x :: * -> *). MonadView m x => x ()
f a
old) (ViewState -> Stack
viewStack ViewState
vs')
            ViewState -> StateT ViewState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ViewState
vs' {viewStack = stack'}
        -- Build added items
        Bool -> StateT ViewState m () -> StateT ViewState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
oldLen) (StateT ViewState m () -> StateT ViewState m ())
-> StateT ViewState m () -> StateT ViewState m ()
forall a b. (a -> b) -> a -> b
$
          [a] -> (a -> StateT ViewState m ()) -> StateT ViewState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
oldLen [a]
items') ((a -> StateT ViewState m ()) -> StateT ViewState m ())
-> (a -> StateT ViewState m ()) -> StateT ViewState m ()
forall a b. (a -> b) -> a -> b
$ \a
new ->
            Build m () -> StateT ViewState m ()
forall (m :: * -> *) a. Build m a -> StateT ViewState m a
unBuild (a -> forall (x :: * -> *). MonadView m x => x ()
f a
new)
      Maybe [a]
Nothing -> [Char] -> StateT ViewState m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"listView: Items not found in stack during rebuild"

runRebuild :: (MonadIO m) => Rebuild m a -> ViewState -> m (a, ViewState)
runRebuild :: forall (m :: * -> *) a.
MonadIO m =>
Rebuild m a -> ViewState -> m (a, ViewState)
runRebuild Rebuild m a
vr = StateT ViewState m a -> ViewState -> m (a, ViewState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Rebuild m a -> StateT ViewState m a
forall (m :: * -> *) a. Rebuild m a -> StateT ViewState m a
unRebuild Rebuild m a
vr)