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

-- |
-- Module      : Concoct.View.Skip
-- 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.Skip (Skip (..), runSkip) where

import Concoct.View.Internal
import Control.Monad.State

newtype Skip m a = Skip {forall (m :: * -> *) a. Skip m a -> StateT ViewState m a
unSkip :: StateT ViewState m a}
  deriving ((forall a b. (a -> b) -> Skip m a -> Skip m b)
-> (forall a b. a -> Skip m b -> Skip m a) -> Functor (Skip m)
forall a b. a -> Skip m b -> Skip m a
forall a b. (a -> b) -> Skip m a -> Skip m b
forall (m :: * -> *) a b. Functor m => a -> Skip m b -> Skip m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Skip m a -> Skip 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) -> Skip m a -> Skip m b
fmap :: forall a b. (a -> b) -> Skip m a -> Skip m b
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> Skip m b -> Skip m a
<$ :: forall a b. a -> Skip m b -> Skip m a
Functor, Functor (Skip m)
Functor (Skip m) =>
(forall a. a -> Skip m a)
-> (forall a b. Skip m (a -> b) -> Skip m a -> Skip m b)
-> (forall a b c.
    (a -> b -> c) -> Skip m a -> Skip m b -> Skip m c)
-> (forall a b. Skip m a -> Skip m b -> Skip m b)
-> (forall a b. Skip m a -> Skip m b -> Skip m a)
-> Applicative (Skip m)
forall a. a -> Skip m a
forall a b. Skip m a -> Skip m b -> Skip m a
forall a b. Skip m a -> Skip m b -> Skip m b
forall a b. Skip m (a -> b) -> Skip m a -> Skip m b
forall a b c. (a -> b -> c) -> Skip m a -> Skip m b -> Skip m c
forall (m :: * -> *). Monad m => Functor (Skip m)
forall (m :: * -> *) a. Monad m => a -> Skip m a
forall (m :: * -> *) a b.
Monad m =>
Skip m a -> Skip m b -> Skip m a
forall (m :: * -> *) a b.
Monad m =>
Skip m a -> Skip m b -> Skip m b
forall (m :: * -> *) a b.
Monad m =>
Skip m (a -> b) -> Skip m a -> Skip m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Skip m a -> Skip m b -> Skip 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 -> Skip m a
pure :: forall a. a -> Skip m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
Skip m (a -> b) -> Skip m a -> Skip m b
<*> :: forall a b. Skip m (a -> b) -> Skip m a -> Skip m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Skip m a -> Skip m b -> Skip m c
liftA2 :: forall a b c. (a -> b -> c) -> Skip m a -> Skip m b -> Skip m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
Skip m a -> Skip m b -> Skip m b
*> :: forall a b. Skip m a -> Skip m b -> Skip m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
Skip m a -> Skip m b -> Skip m a
<* :: forall a b. Skip m a -> Skip m b -> Skip m a
Applicative, Applicative (Skip m)
Applicative (Skip m) =>
(forall a b. Skip m a -> (a -> Skip m b) -> Skip m b)
-> (forall a b. Skip m a -> Skip m b -> Skip m b)
-> (forall a. a -> Skip m a)
-> Monad (Skip m)
forall a. a -> Skip m a
forall a b. Skip m a -> Skip m b -> Skip m b
forall a b. Skip m a -> (a -> Skip m b) -> Skip m b
forall (m :: * -> *). Monad m => Applicative (Skip m)
forall (m :: * -> *) a. Monad m => a -> Skip m a
forall (m :: * -> *) a b.
Monad m =>
Skip m a -> Skip m b -> Skip m b
forall (m :: * -> *) a b.
Monad m =>
Skip m a -> (a -> Skip m b) -> Skip 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 =>
Skip m a -> (a -> Skip m b) -> Skip m b
>>= :: forall a b. Skip m a -> (a -> Skip m b) -> Skip m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Skip m a -> Skip m b -> Skip m b
>> :: forall a b. Skip m a -> Skip m b -> Skip m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> Skip m a
return :: forall a. a -> Skip m a
Monad)

instance (MonadIO m) => MonadView m (Skip m) where
  useState :: forall a. Typeable a => m a -> Skip m (StateRef a)
useState m a
_ = StateT ViewState m (StateRef a) -> Skip m (StateRef a)
forall (m :: * -> *) a. StateT ViewState m a -> Skip m a
Skip 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 -> Skip m (ViewRef a)
useRef m a
_ = StateT ViewState m (ViewRef a) -> Skip m (ViewRef a)
forall (m :: * -> *) a. StateT ViewState m a -> Skip m a
Skip 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 ()) -> Skip m ()
useEffect m d
_ d -> m ()
_ = () -> Skip m ()
forall a. a -> Skip m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  useOnUnmount :: m () -> Skip m ()
useOnUnmount m ()
_ = () -> Skip m ()
forall a. a -> Skip m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  component :: (forall (x :: * -> *). MonadView m x => x ()) -> Skip m ()
component forall (x :: * -> *). MonadView m x => x ()
v = StateT ViewState m () -> Skip m ()
forall (m :: * -> *) a. StateT ViewState m a -> Skip m a
Skip (StateT ViewState m () -> Skip m ())
-> StateT ViewState m () -> Skip m ()
forall a b. (a -> b) -> a -> b
$ (Skip 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 Skip m () -> StateT ViewState m ()
forall (m :: * -> *) a. Skip m a -> StateT ViewState m a
unSkip x ()
forall (x :: * -> *). MonadView m x => x ()
v
  liftView :: m () -> Skip m ()
liftView m ()
_ = () -> Skip m ()
forall a. a -> Skip m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  switchView :: m Bool
-> (forall (x :: * -> *). MonadView m x => x ())
-> (forall (x :: * -> *). MonadView m x => x ())
-> Skip m ()
switchView m Bool
_ forall (x :: * -> *). MonadView m x => x ()
vTrue forall (x :: * -> *). MonadView m x => x ()
vFalse = StateT ViewState m () -> Skip m ()
forall (m :: * -> *) a. StateT ViewState m a -> Skip m a
Skip (StateT ViewState m () -> Skip m ())
-> StateT ViewState m () -> Skip 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
cond' -> do
        ViewState -> StateT ViewState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ViewState
vs {viewStack = pushStack cond' s'}
        if Bool
cond' 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
      Maybe Bool
Nothing -> [Char] -> StateT ViewState m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"switchView: Condition not found in stack during skip"
  listView :: forall a.
(Typeable a, Eq a) =>
m [a]
-> (a -> forall (x :: * -> *). MonadView m x => x ()) -> Skip m ()
listView m [a]
_ a -> forall (x :: * -> *). MonadView m x => x ()
f = StateT ViewState m () -> Skip m ()
forall (m :: * -> *) a. StateT ViewState m a -> Skip m a
Skip (StateT ViewState m () -> Skip m ())
-> StateT ViewState m () -> Skip 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]
mItems, Stack
s') = forall a. Typeable a => Stack -> (Maybe a, Stack)
popStack @[_] (ViewState -> Stack
viewStack ViewState
vs)
    case Maybe [a]
mItems of
      Just [a]
items' -> do
        ViewState -> StateT ViewState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ViewState
vs {viewStack = pushStack items' s'}
        (a -> StateT ViewState m ()) -> [a] -> StateT ViewState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Skip m () -> StateT ViewState m ()
forall (m :: * -> *) a. Skip m a -> StateT ViewState m a
unSkip (Skip m () -> StateT ViewState m ())
-> (a -> Skip m ()) -> a -> StateT ViewState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Skip m ()
a -> forall (x :: * -> *). MonadView m x => x ()
f) [a]
items'
      Maybe [a]
Nothing -> [Char] -> StateT ViewState m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"listView: Items not found in stack during skip"

runSkip :: (MonadIO m) => Skip m a -> ViewState -> m (a, ViewState)
runSkip :: forall (m :: * -> *) a.
MonadIO m =>
Skip m a -> ViewState -> m (a, ViewState)
runSkip Skip m a
vs = StateT ViewState m a -> ViewState -> m (a, ViewState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Skip m a -> StateT ViewState m a
forall (m :: * -> *) a. Skip m a -> StateT ViewState m a
unSkip Skip m a
vs)