{-# Language UndecidableInstances #-}
module Reflex.Vty.Widget.Layout where
import Control.Applicative (liftA2)
import Control.Monad.Morph
import Control.Monad.NodeId (MonadNodeId(..), NodeId)
import Control.Monad.Fix
import Control.Monad.Reader
import Data.List (mapAccumL)
import Data.Map.Ordered (OMap)
import qualified Data.Map.Ordered as OMap
import Data.Maybe (fromMaybe, isNothing)
import Data.Ratio ((%))
import Data.Semigroup (First(..))
import Data.Set.Ordered (OSet)
import qualified Data.Set.Ordered as OSet
import qualified Graphics.Vty as V
import Reflex
import Reflex.Host.Class (MonadReflexCreateTrigger)
import Reflex.Vty.Widget
import Reflex.Vty.Widget.Input.Mouse
newtype FocusId = FocusId NodeId
deriving (FocusId -> FocusId -> Bool
(FocusId -> FocusId -> Bool)
-> (FocusId -> FocusId -> Bool) -> Eq FocusId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FocusId -> FocusId -> Bool
$c/= :: FocusId -> FocusId -> Bool
== :: FocusId -> FocusId -> Bool
$c== :: FocusId -> FocusId -> Bool
Eq, Eq FocusId
Eq FocusId
-> (FocusId -> FocusId -> Ordering)
-> (FocusId -> FocusId -> Bool)
-> (FocusId -> FocusId -> Bool)
-> (FocusId -> FocusId -> Bool)
-> (FocusId -> FocusId -> Bool)
-> (FocusId -> FocusId -> FocusId)
-> (FocusId -> FocusId -> FocusId)
-> Ord FocusId
FocusId -> FocusId -> Bool
FocusId -> FocusId -> Ordering
FocusId -> FocusId -> FocusId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FocusId -> FocusId -> FocusId
$cmin :: FocusId -> FocusId -> FocusId
max :: FocusId -> FocusId -> FocusId
$cmax :: FocusId -> FocusId -> FocusId
>= :: FocusId -> FocusId -> Bool
$c>= :: FocusId -> FocusId -> Bool
> :: FocusId -> FocusId -> Bool
$c> :: FocusId -> FocusId -> Bool
<= :: FocusId -> FocusId -> Bool
$c<= :: FocusId -> FocusId -> Bool
< :: FocusId -> FocusId -> Bool
$c< :: FocusId -> FocusId -> Bool
compare :: FocusId -> FocusId -> Ordering
$ccompare :: FocusId -> FocusId -> Ordering
$cp1Ord :: Eq FocusId
Ord)
newtype FocusSet = FocusSet { FocusSet -> OSet FocusId
unFocusSet :: OSet FocusId }
instance Semigroup FocusSet where
FocusSet OSet FocusId
a <> :: FocusSet -> FocusSet -> FocusSet
<> FocusSet OSet FocusId
b = OSet FocusId -> FocusSet
FocusSet (OSet FocusId -> FocusSet) -> OSet FocusId -> FocusSet
forall a b. (a -> b) -> a -> b
$ OSet FocusId
a OSet FocusId -> OSet FocusId -> OSet FocusId
forall a. Ord a => OSet a -> OSet a -> OSet a
OSet.|<> OSet FocusId
b
instance Monoid FocusSet where
mempty :: FocusSet
mempty = OSet FocusId -> FocusSet
FocusSet OSet FocusId
forall a. OSet a
OSet.empty
singletonFS :: FocusId -> FocusSet
singletonFS :: FocusId -> FocusSet
singletonFS = OSet FocusId -> FocusSet
FocusSet (OSet FocusId -> FocusSet)
-> (FocusId -> OSet FocusId) -> FocusId -> FocusSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusId -> OSet FocusId
forall a. a -> OSet a
OSet.singleton
data Refocus = Refocus_Shift Int
| Refocus_Id FocusId
| Refocus_Clear
shiftFS :: FocusSet -> Maybe FocusId -> Int -> Maybe FocusId
shiftFS :: FocusSet -> Maybe FocusId -> Int -> Maybe FocusId
shiftFS (FocusSet OSet FocusId
s) Maybe FocusId
fid Int
n = case FocusId -> OSet FocusId -> Maybe Int
forall a. Ord a => a -> OSet a -> Maybe Int
OSet.findIndex (FocusId -> OSet FocusId -> Maybe Int)
-> Maybe FocusId -> Maybe (OSet FocusId -> Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FocusId
fid Maybe (OSet FocusId -> Maybe Int)
-> Maybe (OSet FocusId) -> Maybe (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OSet FocusId -> Maybe (OSet FocusId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSet FocusId
s of
Maybe (Maybe Int)
Nothing -> OSet FocusId -> Int -> Maybe FocusId
forall a. OSet a -> Int -> Maybe a
OSet.elemAt OSet FocusId
s Int
0
Just Maybe Int
Nothing -> OSet FocusId -> Int -> Maybe FocusId
forall a. OSet a -> Int -> Maybe a
OSet.elemAt OSet FocusId
s Int
0
Just (Just Int
ix) -> OSet FocusId -> Int -> Maybe FocusId
forall a. OSet a -> Int -> Maybe a
OSet.elemAt OSet FocusId
s (Int -> Maybe FocusId) -> Int -> Maybe FocusId
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (OSet FocusId -> Int
forall a. OSet a -> Int
OSet.size OSet FocusId
s)
class (Monad m, Reflex t) => HasFocus t m | m -> t where
makeFocus :: m FocusId
requestFocus :: Event t Refocus -> m ()
isFocused :: FocusId -> m (Dynamic t Bool)
subFoci :: m a -> m (a, Dynamic t FocusSet)
focusedId :: m (Dynamic t (Maybe FocusId))
newtype Focus t m a = Focus
{ Focus t m a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
unFocus :: DynamicWriterT t FocusSet
(ReaderT (Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)) a
}
deriving
( a -> Focus t m b -> Focus t m a
(a -> b) -> Focus t m a -> Focus t m b
(forall a b. (a -> b) -> Focus t m a -> Focus t m b)
-> (forall a b. a -> Focus t m b -> Focus t m a)
-> Functor (Focus t m)
forall a b. a -> Focus t m b -> Focus t m a
forall a b. (a -> b) -> Focus t m a -> Focus t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> Focus t m b -> Focus t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> Focus t m a -> Focus t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Focus t m b -> Focus t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> Focus t m b -> Focus t m a
fmap :: (a -> b) -> Focus t m a -> Focus t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> Focus t m a -> Focus t m b
Functor
, Functor (Focus t m)
a -> Focus t m a
Functor (Focus t m)
-> (forall a. a -> Focus t m a)
-> (forall a b. Focus t m (a -> b) -> Focus t m a -> Focus t m b)
-> (forall a b c.
(a -> b -> c) -> Focus t m a -> Focus t m b -> Focus t m c)
-> (forall a b. Focus t m a -> Focus t m b -> Focus t m b)
-> (forall a b. Focus t m a -> Focus t m b -> Focus t m a)
-> Applicative (Focus t m)
Focus t m a -> Focus t m b -> Focus t m b
Focus t m a -> Focus t m b -> Focus t m a
Focus t m (a -> b) -> Focus t m a -> Focus t m b
(a -> b -> c) -> Focus t m a -> Focus t m b -> Focus t m c
forall a. a -> Focus t m a
forall a b. Focus t m a -> Focus t m b -> Focus t m a
forall a b. Focus t m a -> Focus t m b -> Focus t m b
forall a b. Focus t m (a -> b) -> Focus t m a -> Focus t m b
forall a b c.
(a -> b -> c) -> Focus t m a -> Focus t m b -> Focus t m c
forall t (m :: * -> *). Monad m => Functor (Focus t m)
forall t (m :: * -> *) a. Monad m => a -> Focus t m a
forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> Focus t m b -> Focus t m a
forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> Focus t m b -> Focus t m b
forall t (m :: * -> *) a b.
Monad m =>
Focus t m (a -> b) -> Focus t m a -> Focus t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Focus t m a -> Focus t m b -> Focus t 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
<* :: Focus t m a -> Focus t m b -> Focus t m a
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> Focus t m b -> Focus t m a
*> :: Focus t m a -> Focus t m b -> Focus t m b
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> Focus t m b -> Focus t m b
liftA2 :: (a -> b -> c) -> Focus t m a -> Focus t m b -> Focus t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Focus t m a -> Focus t m b -> Focus t m c
<*> :: Focus t m (a -> b) -> Focus t m a -> Focus t m b
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
Focus t m (a -> b) -> Focus t m a -> Focus t m b
pure :: a -> Focus t m a
$cpure :: forall t (m :: * -> *) a. Monad m => a -> Focus t m a
$cp1Applicative :: forall t (m :: * -> *). Monad m => Functor (Focus t m)
Applicative
, Applicative (Focus t m)
a -> Focus t m a
Applicative (Focus t m)
-> (forall a b. Focus t m a -> (a -> Focus t m b) -> Focus t m b)
-> (forall a b. Focus t m a -> Focus t m b -> Focus t m b)
-> (forall a. a -> Focus t m a)
-> Monad (Focus t m)
Focus t m a -> (a -> Focus t m b) -> Focus t m b
Focus t m a -> Focus t m b -> Focus t m b
forall a. a -> Focus t m a
forall a b. Focus t m a -> Focus t m b -> Focus t m b
forall a b. Focus t m a -> (a -> Focus t m b) -> Focus t m b
forall t (m :: * -> *). Monad m => Applicative (Focus t m)
forall t (m :: * -> *) a. Monad m => a -> Focus t m a
forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> Focus t m b -> Focus t m b
forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> (a -> Focus t m b) -> Focus t 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
return :: a -> Focus t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> Focus t m a
>> :: Focus t m a -> Focus t m b -> Focus t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> Focus t m b -> Focus t m b
>>= :: Focus t m a -> (a -> Focus t m b) -> Focus t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> (a -> Focus t m b) -> Focus t m b
$cp1Monad :: forall t (m :: * -> *). Monad m => Applicative (Focus t m)
Monad
, MonadHold t
, MonadSample t
, Monad (Focus t m)
Monad (Focus t m)
-> (forall a. (a -> Focus t m a) -> Focus t m a)
-> MonadFix (Focus t m)
(a -> Focus t m a) -> Focus t m a
forall a. (a -> Focus t m a) -> Focus t m a
forall t (m :: * -> *). MonadFix m => Monad (Focus t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> Focus t m a) -> Focus t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> Focus t m a) -> Focus t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> Focus t m a) -> Focus t m a
$cp1MonadFix :: forall t (m :: * -> *). MonadFix m => Monad (Focus t m)
MonadFix
, TriggerEvent t
, PerformEvent t
, NotReady t
, MonadReflexCreateTrigger t
, HasDisplayRegion t
, PostBuild t
, Monad (Focus t m)
Focus t m NodeId
Monad (Focus t m) -> Focus t m NodeId -> MonadNodeId (Focus t m)
forall t (m :: * -> *). MonadNodeId m => Monad (Focus t m)
forall t (m :: * -> *). MonadNodeId m => Focus t m NodeId
forall (m :: * -> *). Monad m -> m NodeId -> MonadNodeId m
getNextNodeId :: Focus t m NodeId
$cgetNextNodeId :: forall t (m :: * -> *). MonadNodeId m => Focus t m NodeId
$cp1MonadNodeId :: forall t (m :: * -> *). MonadNodeId m => Monad (Focus t m)
MonadNodeId
, Monad (Focus t m)
Monad (Focus t m)
-> (forall a. IO a -> Focus t m a) -> MonadIO (Focus t m)
IO a -> Focus t m a
forall a. IO a -> Focus t m a
forall t (m :: * -> *). MonadIO m => Monad (Focus t m)
forall t (m :: * -> *) a. MonadIO m => IO a -> Focus t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Focus t m a
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> Focus t m a
$cp1MonadIO :: forall t (m :: * -> *). MonadIO m => Monad (Focus t m)
MonadIO
)
instance MonadTrans (Focus t) where
lift :: m a -> Focus t m a
lift = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a)
-> (m a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a)
-> m a
-> Focus t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m) a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m) a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a)
-> (m a
-> ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m) a)
-> m a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventWriterT t (First Refocus) m a
-> ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventWriterT t (First Refocus) m a
-> ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m) a)
-> (m a -> EventWriterT t (First Refocus) m a)
-> m a
-> ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> EventWriterT t (First Refocus) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MFunctor (Focus t) where
hoist :: (forall a. m a -> n a) -> Focus t m b -> Focus t n b
hoist forall a. m a -> n a
f = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) n))
b
-> Focus t n b
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) n))
b
-> Focus t n b)
-> (Focus t m b
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) n))
b)
-> Focus t m b
-> Focus t n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m) a
-> ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) n) a)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) n))
b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a.
EventWriterT t (First Refocus) m a
-> EventWriterT t (First Refocus) n a)
-> ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m) a
-> ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) n) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. m a -> n a)
-> EventWriterT t (First Refocus) m a
-> EventWriterT t (First Refocus) n a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
f)) (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) n))
b)
-> (Focus t m b
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b)
-> Focus t m b
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) n))
b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Focus t m b
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b
forall t (m :: * -> *) a.
Focus t m a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
unFocus
instance (Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (Focus t m) where
runWithReplace :: Focus t m a -> Event t (Focus t m b) -> Focus t m (a, Event t b)
runWithReplace (Focus DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
a) Event t (Focus t m b)
e = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Event t b)
-> Focus t m (a, Event t b)
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Event t b)
-> Focus t m (a, Event t b))
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Event t b)
-> Focus t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Event
t
(DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
a (Event
t
(DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Event t b))
-> Event
t
(DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Event t b)
forall a b. (a -> b) -> a -> b
$ (Focus t m b
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b)
-> Event t (Focus t m b)
-> Event
t
(DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Focus t m b
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
b
forall t (m :: * -> *) a.
Focus t m a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
unFocus Event t (Focus t m b)
e
traverseIntMapWithKeyWithAdjust :: (Int -> v -> Focus t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> Focus t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Int -> v -> Focus t m v'
f IntMap v
m Event t (PatchIntMap v)
e = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(IntMap v', Event t (PatchIntMap v'))
-> Focus t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(IntMap v', Event t (PatchIntMap v'))
-> Focus t m (IntMap v', Event t (PatchIntMap v')))
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(IntMap v', Event t (PatchIntMap v'))
-> Focus t m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$ (Int
-> v
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
v')
-> IntMap v
-> Event t (PatchIntMap v)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Int
k v
v -> Focus t m v'
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
v'
forall t (m :: * -> *) a.
Focus t m a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
unFocus (Focus t m v'
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
v')
-> Focus t m v'
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
v'
forall a b. (a -> b) -> a -> b
$ Int -> v -> Focus t m v'
f Int
k v
v) IntMap v
m Event t (PatchIntMap v)
e
traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> Focus t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> Focus t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> Focus t m (v' a)
f DMap k v
m Event t (PatchDMap k v)
e = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(DMap k v', Event t (PatchDMap k v'))
-> Focus t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(DMap k v', Event t (PatchDMap k v'))
-> Focus t m (DMap k v', Event t (PatchDMap k v')))
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(DMap k v', Event t (PatchDMap k v'))
-> Focus t m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ (forall a.
k a
-> v a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
k v a
v -> Focus t m (v' a)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(v' a)
forall t (m :: * -> *) a.
Focus t m a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
unFocus (Focus t m (v' a)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(v' a))
-> Focus t m (v' a)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> Focus t m (v' a)
forall a. k a -> v a -> Focus t m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMap k v)
e
traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> Focus t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> Focus t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> Focus t m (v' a)
f DMap k v
m Event t (PatchDMapWithMove k v)
e = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(DMap k v', Event t (PatchDMapWithMove k v'))
-> Focus t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(DMap k v', Event t (PatchDMapWithMove k v'))
-> Focus t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(DMap k v', Event t (PatchDMapWithMove k v'))
-> Focus t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ (forall a.
k a
-> v a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
k v a
v -> Focus t m (v' a)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(v' a)
forall t (m :: * -> *) a.
Focus t m a
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
unFocus (Focus t m (v' a)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(v' a))
-> Focus t m (v' a)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> Focus t m (v' a)
forall a. k a -> v a -> Focus t m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMapWithMove k v)
e
instance (Reflex t, MonadFix m, HasInput t m) => HasInput t (Focus t m) where
localInput :: (Event t VtyEvent -> Event t VtyEvent)
-> Focus t m a -> Focus t m a
localInput Event t VtyEvent -> Event t VtyEvent
f = (forall a. m a -> m a) -> Focus t m a -> Focus t m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((Event t VtyEvent -> Event t VtyEvent) -> m a -> m a
forall k (t :: k) (m :: * -> *) a.
HasInput t m =>
(Event t VtyEvent -> Event t VtyEvent) -> m a -> m a
localInput Event t VtyEvent -> Event t VtyEvent
f)
instance (HasImageWriter t m, MonadFix m) => HasImageWriter t (Focus t m) where
mapImages :: (Behavior t [Image] -> Behavior t [Image])
-> Focus t m a -> Focus t m a
mapImages Behavior t [Image] -> Behavior t [Image]
f = (forall a. m a -> m a) -> Focus t m a -> Focus t m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((Behavior t [Image] -> Behavior t [Image]) -> m a -> m a
forall k (t :: k) (m :: * -> *) a.
HasImageWriter t m =>
(Behavior t [Image] -> Behavior t [Image]) -> m a -> m a
mapImages Behavior t [Image] -> Behavior t [Image]
f)
instance (HasFocusReader t m, Monad m) => HasFocusReader t (Focus t m)
instance (HasTheme t m, Monad m) => HasTheme t (Focus t m)
instance (Reflex t, MonadFix m, MonadNodeId m) => HasFocus t (Focus t m) where
makeFocus :: Focus t m FocusId
makeFocus = do
FocusId
fid <- NodeId -> FocusId
FocusId (NodeId -> FocusId) -> Focus t m NodeId -> Focus t m FocusId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m NodeId -> Focus t m NodeId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m NodeId
forall (m :: * -> *). MonadNodeId m => m NodeId
getNextNodeId
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
-> Focus t m ()
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
-> Focus t m ())
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
-> Focus t m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t FocusSet
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
forall t w (m :: * -> *).
DynamicWriter t w m =>
Dynamic t w -> m ()
tellDyn (Dynamic t FocusSet
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
())
-> Dynamic t FocusSet
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
forall a b. (a -> b) -> a -> b
$ FocusSet -> Dynamic t FocusSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FocusSet -> Dynamic t FocusSet) -> FocusSet -> Dynamic t FocusSet
forall a b. (a -> b) -> a -> b
$ FocusId -> FocusSet
singletonFS FocusId
fid
FocusId -> Focus t m FocusId
forall (f :: * -> *) a. Applicative f => a -> f a
pure FocusId
fid
requestFocus :: Event t Refocus -> Focus t m ()
requestFocus = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
-> Focus t m ()
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
-> Focus t m ())
-> (Event t Refocus
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
())
-> Event t Refocus
-> Focus t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (First Refocus)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
forall t w (m :: * -> *). EventWriter t w m => Event t w -> m ()
tellEvent (Event t (First Refocus)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
())
-> (Event t Refocus -> Event t (First Refocus))
-> Event t Refocus
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Refocus -> First Refocus)
-> Event t Refocus -> Event t (First Refocus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Refocus -> First Refocus
forall a. a -> First a
First
isFocused :: FocusId -> Focus t m (Dynamic t Bool)
isFocused FocusId
fid = do
Dynamic t (Maybe FocusId)
sel <- DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(Dynamic t (Maybe FocusId))
-> Focus t m (Dynamic t (Maybe FocusId))
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(Dynamic t (Maybe FocusId))
forall r (m :: * -> *). MonadReader r m => m r
ask
Dynamic t Bool -> Focus t m (Dynamic t Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dynamic t Bool -> Focus t m (Dynamic t Bool))
-> Dynamic t Bool -> Focus t m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ (Maybe FocusId -> Maybe FocusId -> Bool
forall a. Eq a => a -> a -> Bool
== FocusId -> Maybe FocusId
forall a. a -> Maybe a
Just FocusId
fid) (Maybe FocusId -> Bool)
-> Dynamic t (Maybe FocusId) -> Dynamic t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Maybe FocusId)
sel
subFoci :: Focus t m a -> Focus t m (a, Dynamic t FocusSet)
subFoci (Focus DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
child) = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Dynamic t FocusSet)
-> Focus t m (a, Dynamic t FocusSet)
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus (DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Dynamic t FocusSet)
-> Focus t m (a, Dynamic t FocusSet))
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Dynamic t FocusSet)
-> Focus t m (a, Dynamic t FocusSet)
forall a b. (a -> b) -> a -> b
$ do
(a
a, Dynamic t FocusSet
fs) <- ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Dynamic t FocusSet)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Dynamic t FocusSet))
-> ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Dynamic t FocusSet)
forall a b. (a -> b) -> a -> b
$ DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
forall (m :: * -> *) t w a.
(MonadFix m, Reflex t, Monoid w) =>
DynamicWriterT t w m a -> m (a, Dynamic t w)
runDynamicWriterT DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
child
Dynamic t FocusSet
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
()
forall t w (m :: * -> *).
DynamicWriter t w m =>
Dynamic t w -> m ()
tellDyn Dynamic t FocusSet
fs
(a, Dynamic t FocusSet)
-> DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(a, Dynamic t FocusSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Dynamic t FocusSet
fs)
focusedId :: Focus t m (Dynamic t (Maybe FocusId))
focusedId = DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(Dynamic t (Maybe FocusId))
-> Focus t m (Dynamic t (Maybe FocusId))
forall t (m :: * -> *) a.
DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> Focus t m a
Focus DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
(Dynamic t (Maybe FocusId))
forall r (m :: * -> *). MonadReader r m => m r
ask
runFocus
:: (MonadFix m, MonadHold t m, Reflex t)
=> Focus t m a
-> m (a, Dynamic t FocusSet)
runFocus :: Focus t m a -> m (a, Dynamic t FocusSet)
runFocus (Focus DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
x) = do
rec ((a
a, Dynamic t FocusSet
focusIds), Event t (First Refocus)
focusRequests) <- EventWriterT t (First Refocus) m (a, Dynamic t FocusSet)
-> m ((a, Dynamic t FocusSet), Event t (First Refocus))
forall t (m :: * -> *) w a.
(Reflex t, Monad m, Semigroup w) =>
EventWriterT t w m a -> m (a, Event t w)
runEventWriterT (EventWriterT t (First Refocus) m (a, Dynamic t FocusSet)
-> m ((a, Dynamic t FocusSet), Event t (First Refocus)))
-> EventWriterT t (First Refocus) m (a, Dynamic t FocusSet)
-> m ((a, Dynamic t FocusSet), Event t (First Refocus))
forall a b. (a -> b) -> a -> b
$ (ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
-> Dynamic t (Maybe FocusId)
-> EventWriterT t (First Refocus) m (a, Dynamic t FocusSet))
-> Dynamic t (Maybe FocusId)
-> ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
-> EventWriterT t (First Refocus) m (a, Dynamic t FocusSet)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
-> Dynamic t (Maybe FocusId)
-> EventWriterT t (First Refocus) m (a, Dynamic t FocusSet)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Dynamic t (Maybe FocusId)
sel (ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
-> EventWriterT t (First Refocus) m (a, Dynamic t FocusSet))
-> ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
-> EventWriterT t (First Refocus) m (a, Dynamic t FocusSet)
forall a b. (a -> b) -> a -> b
$ DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
-> ReaderT
(Dynamic t (Maybe FocusId))
(EventWriterT t (First Refocus) m)
(a, Dynamic t FocusSet)
forall (m :: * -> *) t w a.
(MonadFix m, Reflex t, Monoid w) =>
DynamicWriterT t w m a -> m (a, Dynamic t w)
runDynamicWriterT DynamicWriterT
t
FocusSet
(ReaderT
(Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
a
x
Dynamic t (Maybe FocusId)
sel <- ((FocusSet, First Refocus) -> Maybe FocusId -> Maybe FocusId)
-> Maybe FocusId
-> Event t (FocusSet, First Refocus)
-> m (Dynamic t (Maybe FocusId))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (FocusSet, First Refocus) -> Maybe FocusId -> Maybe FocusId
f Maybe FocusId
forall a. Maybe a
Nothing (Event t (FocusSet, First Refocus)
-> m (Dynamic t (Maybe FocusId)))
-> Event t (FocusSet, First Refocus)
-> m (Dynamic t (Maybe FocusId))
forall a b. (a -> b) -> a -> b
$ Behavior t FocusSet
-> Event t (First Refocus) -> Event t (FocusSet, First Refocus)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t FocusSet -> Behavior t FocusSet
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t FocusSet
focusIds) Event t (First Refocus)
focusRequests
(a, Dynamic t FocusSet) -> m (a, Dynamic t FocusSet)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Dynamic t FocusSet
focusIds)
where
f :: (FocusSet, First Refocus) -> Maybe FocusId -> Maybe FocusId
f :: (FocusSet, First Refocus) -> Maybe FocusId -> Maybe FocusId
f (FocusSet
fs, First Refocus
rf) Maybe FocusId
mf = case First Refocus -> Refocus
forall a. First a -> a
getFirst First Refocus
rf of
Refocus
Refocus_Clear -> Maybe FocusId
forall a. Maybe a
Nothing
Refocus_Id FocusId
fid -> FocusId -> Maybe FocusId
forall a. a -> Maybe a
Just FocusId
fid
Refocus_Shift Int
n -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Maybe FocusId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FocusId
mf
then FocusSet -> Maybe FocusId -> Int -> Maybe FocusId
shiftFS FocusSet
fs (OSet FocusId -> Int -> Maybe FocusId
forall a. OSet a -> Int -> Maybe a
OSet.elemAt (FocusSet -> OSet FocusId
unFocusSet FocusSet
fs) Int
0) Int
n
else FocusSet -> Maybe FocusId -> Int -> Maybe FocusId
shiftFS FocusSet
fs Maybe FocusId
mf Int
n
anyChildFocused
:: (HasFocus t m, MonadFix m)
=> (Dynamic t Bool -> m a)
-> m a
anyChildFocused :: (Dynamic t Bool -> m a) -> m a
anyChildFocused Dynamic t Bool -> m a
f = do
Dynamic t (Maybe FocusId)
fid <- m (Dynamic t (Maybe FocusId))
forall k (t :: k) (m :: * -> *).
HasFocus t m =>
m (Dynamic t (Maybe FocusId))
focusedId
rec (a
a, Dynamic t FocusSet
fs) <- m a -> m (a, Dynamic t FocusSet)
forall k (t :: k) (m :: * -> *) a.
HasFocus t m =>
m a -> m (a, Dynamic t FocusSet)
subFoci (Dynamic t Bool -> m a
f Dynamic t Bool
b)
let b :: Dynamic t Bool
b = (Maybe FocusId -> FocusSet -> Bool)
-> Dynamic t (Maybe FocusId)
-> Dynamic t FocusSet
-> Dynamic t Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\Maybe FocusId
foc FocusSet
s -> case Maybe FocusId
foc of
Maybe FocusId
Nothing -> Bool
False
Just FocusId
f' -> FocusId -> OSet FocusId -> Bool
forall a. Ord a => a -> OSet a -> Bool
OSet.member FocusId
f' (OSet FocusId -> Bool) -> OSet FocusId -> Bool
forall a b. (a -> b) -> a -> b
$ FocusSet -> OSet FocusId
unFocusSet FocusSet
s) Dynamic t (Maybe FocusId)
fid Dynamic t FocusSet
fs
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
tabNavigation :: (Reflex t, HasInput t m, HasFocus t m) => m ()
tabNavigation :: m ()
tabNavigation = do
Event t Int
fwd <- (KeyCombo -> Int) -> Event t KeyCombo -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> KeyCombo -> Int
forall a b. a -> b -> a
const Int
1) (Event t KeyCombo -> Event t Int)
-> m (Event t KeyCombo) -> m (Event t Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> m (Event t KeyCombo)
forall k (m :: * -> *) (t :: k).
(Monad m, Reflex t, HasInput t m) =>
Key -> m (Event t KeyCombo)
key (Char -> Key
V.KChar Char
'\t')
Event t Int
back <- (KeyCombo -> Int) -> Event t KeyCombo -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> KeyCombo -> Int
forall a b. a -> b -> a
const (-Int
1)) (Event t KeyCombo -> Event t Int)
-> m (Event t KeyCombo) -> m (Event t Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> m (Event t KeyCombo)
forall k (m :: * -> *) (t :: k).
(Monad m, Reflex t, HasInput t m) =>
Key -> m (Event t KeyCombo)
key Key
V.KBackTab
Event t Refocus -> m ()
forall k (t :: k) (m :: * -> *).
HasFocus t m =>
Event t Refocus -> m ()
requestFocus (Event t Refocus -> m ()) -> Event t Refocus -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Refocus
Refocus_Shift (Int -> Refocus) -> Event t Int -> Event t Refocus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t Int
fwd, Event t Int
back]
data Constraint = Constraint_Fixed Int
| Constraint_Min Int
deriving (Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> String
(Int -> Constraint -> ShowS)
-> (Constraint -> String)
-> ([Constraint] -> ShowS)
-> Show Constraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraint] -> ShowS
$cshowList :: [Constraint] -> ShowS
show :: Constraint -> String
$cshow :: Constraint -> String
showsPrec :: Int -> Constraint -> ShowS
$cshowsPrec :: Int -> Constraint -> ShowS
Show, ReadPrec [Constraint]
ReadPrec Constraint
Int -> ReadS Constraint
ReadS [Constraint]
(Int -> ReadS Constraint)
-> ReadS [Constraint]
-> ReadPrec Constraint
-> ReadPrec [Constraint]
-> Read Constraint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constraint]
$creadListPrec :: ReadPrec [Constraint]
readPrec :: ReadPrec Constraint
$creadPrec :: ReadPrec Constraint
readList :: ReadS [Constraint]
$creadList :: ReadS [Constraint]
readsPrec :: Int -> ReadS Constraint
$creadsPrec :: Int -> ReadS Constraint
Read, Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c== :: Constraint -> Constraint -> Bool
Eq, Eq Constraint
Eq Constraint
-> (Constraint -> Constraint -> Ordering)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Constraint)
-> (Constraint -> Constraint -> Constraint)
-> Ord Constraint
Constraint -> Constraint -> Bool
Constraint -> Constraint -> Ordering
Constraint -> Constraint -> Constraint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Constraint -> Constraint -> Constraint
$cmin :: Constraint -> Constraint -> Constraint
max :: Constraint -> Constraint -> Constraint
$cmax :: Constraint -> Constraint -> Constraint
>= :: Constraint -> Constraint -> Bool
$c>= :: Constraint -> Constraint -> Bool
> :: Constraint -> Constraint -> Bool
$c> :: Constraint -> Constraint -> Bool
<= :: Constraint -> Constraint -> Bool
$c<= :: Constraint -> Constraint -> Bool
< :: Constraint -> Constraint -> Bool
$c< :: Constraint -> Constraint -> Bool
compare :: Constraint -> Constraint -> Ordering
$ccompare :: Constraint -> Constraint -> Ordering
$cp1Ord :: Eq Constraint
Ord)
fixed
:: Reflex t
=> Dynamic t Int
-> Dynamic t Constraint
fixed :: Dynamic t Int -> Dynamic t Constraint
fixed = (Int -> Constraint) -> Dynamic t Int -> Dynamic t Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Constraint
Constraint_Fixed
stretch
:: Reflex t
=> Dynamic t Int
-> Dynamic t Constraint
stretch :: Dynamic t Int -> Dynamic t Constraint
stretch = (Int -> Constraint) -> Dynamic t Int -> Dynamic t Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Constraint
Constraint_Min
flex
:: Reflex t
=> Dynamic t Constraint
flex :: Dynamic t Constraint
flex = Constraint -> Dynamic t Constraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constraint -> Dynamic t Constraint)
-> Constraint -> Dynamic t Constraint
forall a b. (a -> b) -> a -> b
$ Int -> Constraint
Constraint_Min Int
0
data Orientation = Orientation_Column
| Orientation_Row
deriving (Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show, ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
(Int -> ReadS Orientation)
-> ReadS [Orientation]
-> ReadPrec Orientation
-> ReadPrec [Orientation]
-> Read Orientation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Orientation]
$creadListPrec :: ReadPrec [Orientation]
readPrec :: ReadPrec Orientation
$creadPrec :: ReadPrec Orientation
readList :: ReadS [Orientation]
$creadList :: ReadS [Orientation]
readsPrec :: Int -> ReadS Orientation
$creadsPrec :: Int -> ReadS Orientation
Read, Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, Eq Orientation
Eq Orientation
-> (Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmax :: Orientation -> Orientation -> Orientation
>= :: Orientation -> Orientation -> Bool
$c>= :: Orientation -> Orientation -> Bool
> :: Orientation -> Orientation -> Bool
$c> :: Orientation -> Orientation -> Bool
<= :: Orientation -> Orientation -> Bool
$c<= :: Orientation -> Orientation -> Bool
< :: Orientation -> Orientation -> Bool
$c< :: Orientation -> Orientation -> Bool
compare :: Orientation -> Orientation -> Ordering
$ccompare :: Orientation -> Orientation -> Ordering
$cp1Ord :: Eq Orientation
Ord)
row
:: (Reflex t, MonadFix m, HasLayout t m)
=> m a
-> m a
row :: m a -> m a
row = Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
forall k (t :: k) (m :: * -> *) a.
HasLayout t m =>
Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
axis (Orientation -> Dynamic t Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Orientation_Row) Dynamic t Constraint
forall k (t :: k). Reflex t => Dynamic t Constraint
flex
col
:: (Reflex t, MonadFix m, HasLayout t m)
=> m a
-> m a
col :: m a -> m a
col = Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
forall k (t :: k) (m :: * -> *) a.
HasLayout t m =>
Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
axis (Orientation -> Dynamic t Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Orientation_Column) Dynamic t Constraint
forall k (t :: k). Reflex t => Dynamic t Constraint
flex
data LayoutTree a = LayoutTree a (LayoutForest a)
deriving (Int -> LayoutTree a -> ShowS
[LayoutTree a] -> ShowS
LayoutTree a -> String
(Int -> LayoutTree a -> ShowS)
-> (LayoutTree a -> String)
-> ([LayoutTree a] -> ShowS)
-> Show (LayoutTree a)
forall a. Show a => Int -> LayoutTree a -> ShowS
forall a. Show a => [LayoutTree a] -> ShowS
forall a. Show a => LayoutTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutTree a] -> ShowS
$cshowList :: forall a. Show a => [LayoutTree a] -> ShowS
show :: LayoutTree a -> String
$cshow :: forall a. Show a => LayoutTree a -> String
showsPrec :: Int -> LayoutTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LayoutTree a -> ShowS
Show)
newtype LayoutForest a = LayoutForest { LayoutForest a -> OMap NodeId (LayoutTree a)
unLayoutForest :: OMap NodeId (LayoutTree a) }
deriving (Int -> LayoutForest a -> ShowS
[LayoutForest a] -> ShowS
LayoutForest a -> String
(Int -> LayoutForest a -> ShowS)
-> (LayoutForest a -> String)
-> ([LayoutForest a] -> ShowS)
-> Show (LayoutForest a)
forall a. Show a => Int -> LayoutForest a -> ShowS
forall a. Show a => [LayoutForest a] -> ShowS
forall a. Show a => LayoutForest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutForest a] -> ShowS
$cshowList :: forall a. Show a => [LayoutForest a] -> ShowS
show :: LayoutForest a -> String
$cshow :: forall a. Show a => LayoutForest a -> String
showsPrec :: Int -> LayoutForest a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LayoutForest a -> ShowS
Show)
instance Semigroup (LayoutForest a) where
LayoutForest OMap NodeId (LayoutTree a)
a <> :: LayoutForest a -> LayoutForest a -> LayoutForest a
<> LayoutForest OMap NodeId (LayoutTree a)
b = OMap NodeId (LayoutTree a) -> LayoutForest a
forall a. OMap NodeId (LayoutTree a) -> LayoutForest a
LayoutForest (OMap NodeId (LayoutTree a) -> LayoutForest a)
-> OMap NodeId (LayoutTree a) -> LayoutForest a
forall a b. (a -> b) -> a -> b
$ OMap NodeId (LayoutTree a)
a OMap NodeId (LayoutTree a)
-> OMap NodeId (LayoutTree a) -> OMap NodeId (LayoutTree a)
forall k v. Ord k => OMap k v -> OMap k v -> OMap k v
OMap.|<> OMap NodeId (LayoutTree a)
b
instance Monoid (LayoutForest a) where
mempty :: LayoutForest a
mempty = OMap NodeId (LayoutTree a) -> LayoutForest a
forall a. OMap NodeId (LayoutTree a) -> LayoutForest a
LayoutForest OMap NodeId (LayoutTree a)
forall k v. OMap k v
OMap.empty
lookupLF :: NodeId -> LayoutForest a -> Maybe (LayoutTree a)
lookupLF :: NodeId -> LayoutForest a -> Maybe (LayoutTree a)
lookupLF NodeId
n (LayoutForest OMap NodeId (LayoutTree a)
a) = NodeId -> OMap NodeId (LayoutTree a) -> Maybe (LayoutTree a)
forall k v. Ord k => k -> OMap k v -> Maybe v
OMap.lookup NodeId
n OMap NodeId (LayoutTree a)
a
singletonLF :: NodeId -> LayoutTree a -> LayoutForest a
singletonLF :: NodeId -> LayoutTree a -> LayoutForest a
singletonLF NodeId
n LayoutTree a
t = OMap NodeId (LayoutTree a) -> LayoutForest a
forall a. OMap NodeId (LayoutTree a) -> LayoutForest a
LayoutForest (OMap NodeId (LayoutTree a) -> LayoutForest a)
-> OMap NodeId (LayoutTree a) -> LayoutForest a
forall a b. (a -> b) -> a -> b
$ (NodeId, LayoutTree a) -> OMap NodeId (LayoutTree a)
forall k v. (k, v) -> OMap k v
OMap.singleton (NodeId
n, LayoutTree a
t)
fromListLF :: [(NodeId, LayoutTree a)] -> LayoutForest a
fromListLF :: [(NodeId, LayoutTree a)] -> LayoutForest a
fromListLF = OMap NodeId (LayoutTree a) -> LayoutForest a
forall a. OMap NodeId (LayoutTree a) -> LayoutForest a
LayoutForest (OMap NodeId (LayoutTree a) -> LayoutForest a)
-> ([(NodeId, LayoutTree a)] -> OMap NodeId (LayoutTree a))
-> [(NodeId, LayoutTree a)]
-> LayoutForest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(NodeId, LayoutTree a)] -> OMap NodeId (LayoutTree a)
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList
rootLT :: LayoutTree a -> a
rootLT :: LayoutTree a -> a
rootLT (LayoutTree a
a LayoutForest a
_) = a
a
childrenLT :: LayoutTree a -> LayoutForest a
childrenLT :: LayoutTree a -> LayoutForest a
childrenLT (LayoutTree a
_ LayoutForest a
a) = LayoutForest a
a
solve
:: Orientation
-> Region
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation)
solve :: Orientation
-> Region
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation)
solve Orientation
o0 Region
r0 (LayoutForest OMap NodeId (LayoutTree (Constraint, Orientation))
cs) =
let a :: [((NodeId, LayoutTree (Constraint, Orientation)), Constraint)]
a = ((NodeId, LayoutTree (Constraint, Orientation))
-> ((NodeId, LayoutTree (Constraint, Orientation)), Constraint))
-> [(NodeId, LayoutTree (Constraint, Orientation))]
-> [((NodeId, LayoutTree (Constraint, Orientation)), Constraint)]
forall a b. (a -> b) -> [a] -> [b]
map (\(NodeId
x, t :: LayoutTree (Constraint, Orientation)
t@(LayoutTree (Constraint
c, Orientation
_) LayoutForest (Constraint, Orientation)
_)) -> ((NodeId
x, LayoutTree (Constraint, Orientation)
t), Constraint
c)) ([(NodeId, LayoutTree (Constraint, Orientation))]
-> [((NodeId, LayoutTree (Constraint, Orientation)), Constraint)])
-> [(NodeId, LayoutTree (Constraint, Orientation))]
-> [((NodeId, LayoutTree (Constraint, Orientation)), Constraint)]
forall a b. (a -> b) -> a -> b
$ OMap NodeId (LayoutTree (Constraint, Orientation))
-> [(NodeId, LayoutTree (Constraint, Orientation))]
forall k v. OMap k v -> [(k, v)]
OMap.assocs OMap NodeId (LayoutTree (Constraint, Orientation))
cs
extent :: Int
extent = case Orientation
o0 of
Orientation
Orientation_Row -> Region -> Int
_region_width Region
r0
Orientation
Orientation_Column -> Region -> Int
_region_height Region
r0
sizes :: [((NodeId, LayoutTree (Constraint, Orientation)), (Int, Int))]
sizes = [((NodeId, LayoutTree (Constraint, Orientation)), Int)]
-> [((NodeId, LayoutTree (Constraint, Orientation)), (Int, Int))]
forall a. [(a, Int)] -> [(a, (Int, Int))]
computeEdges ([((NodeId, LayoutTree (Constraint, Orientation)), Int)]
-> [((NodeId, LayoutTree (Constraint, Orientation)), (Int, Int))])
-> [((NodeId, LayoutTree (Constraint, Orientation)), Int)]
-> [((NodeId, LayoutTree (Constraint, Orientation)), (Int, Int))]
forall a b. (a -> b) -> a -> b
$ Int
-> [((NodeId, LayoutTree (Constraint, Orientation)), Constraint)]
-> [((NodeId, LayoutTree (Constraint, Orientation)), Int)]
forall a. Int -> [(a, Constraint)] -> [(a, Int)]
computeSizes Int
extent [((NodeId, LayoutTree (Constraint, Orientation)), Constraint)]
a
chunks :: [(NodeId, LayoutTree (Region, Orientation))]
chunks = [ (NodeId
nodeId, Orientation
-> Region
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation)
solve Orientation
o1 Region
r1 LayoutForest (Constraint, Orientation)
f)
| ((NodeId
nodeId, LayoutTree (Constraint
_, Orientation
o1) LayoutForest (Constraint, Orientation)
f), (Int, Int)
sz) <- [((NodeId, LayoutTree (Constraint, Orientation)), (Int, Int))]
sizes
, let r1 :: Region
r1 = Orientation -> Region -> (Int, Int) -> Region
chunk Orientation
o0 Region
r0 (Int, Int)
sz
]
in (Region, Orientation)
-> LayoutForest (Region, Orientation)
-> LayoutTree (Region, Orientation)
forall a. a -> LayoutForest a -> LayoutTree a
LayoutTree (Region
r0, Orientation
o0) (LayoutForest (Region, Orientation)
-> LayoutTree (Region, Orientation))
-> LayoutForest (Region, Orientation)
-> LayoutTree (Region, Orientation)
forall a b. (a -> b) -> a -> b
$ [(NodeId, LayoutTree (Region, Orientation))]
-> LayoutForest (Region, Orientation)
forall a. [(NodeId, LayoutTree a)] -> LayoutForest a
fromListLF [(NodeId, LayoutTree (Region, Orientation))]
chunks
where
computeEdges :: [(a, Int)] -> [(a, (Int, Int))]
computeEdges :: [(a, Int)] -> [(a, (Int, Int))]
computeEdges = (([(a, (Int, Int))] -> [(a, (Int, Int))])
-> [(a, (Int, Int))] -> [(a, (Int, Int))]
forall a b. (a -> b) -> a -> b
$ []) (([(a, (Int, Int))] -> [(a, (Int, Int))]) -> [(a, (Int, Int))])
-> ([(a, Int)] -> [(a, (Int, Int))] -> [(a, (Int, Int))])
-> [(a, Int)]
-> [(a, (Int, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, (Int, Int))] -> [(a, (Int, Int))], Int)
-> [(a, (Int, Int))] -> [(a, (Int, Int))]
forall a b. (a, b) -> a
fst (([(a, (Int, Int))] -> [(a, (Int, Int))], Int)
-> [(a, (Int, Int))] -> [(a, (Int, Int))])
-> ([(a, Int)] -> ([(a, (Int, Int))] -> [(a, (Int, Int))], Int))
-> [(a, Int)]
-> [(a, (Int, Int))]
-> [(a, (Int, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(a, (Int, Int))] -> [(a, (Int, Int))], Int)
-> (a, Int) -> ([(a, (Int, Int))] -> [(a, (Int, Int))], Int))
-> ([(a, (Int, Int))] -> [(a, (Int, Int))], Int)
-> [(a, Int)]
-> ([(a, (Int, Int))] -> [(a, (Int, Int))], Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\([(a, (Int, Int))] -> [(a, (Int, Int))]
m, Int
offset) (a
a, Int
sz) ->
(((a
a, (Int
offset, Int
sz)) (a, (Int, Int)) -> [(a, (Int, Int))] -> [(a, (Int, Int))]
forall a. a -> [a] -> [a]
:) ([(a, (Int, Int))] -> [(a, (Int, Int))])
-> ([(a, (Int, Int))] -> [(a, (Int, Int))])
-> [(a, (Int, Int))]
-> [(a, (Int, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, (Int, Int))] -> [(a, (Int, Int))]
m, Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)) ([(a, (Int, Int))] -> [(a, (Int, Int))]
forall a. a -> a
id, Int
0)
computeSizes
:: Int
-> [(a, Constraint)]
-> [(a, Int)]
computeSizes :: Int -> [(a, Constraint)] -> [(a, Int)]
computeSizes Int
available [(a, Constraint)]
constraints =
let minTotal :: Int
minTotal = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [(a, Constraint)] -> ((a, Constraint) -> Int) -> [Int]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor [(a, Constraint)]
constraints (((a, Constraint) -> Int) -> [Int])
-> ((a, Constraint) -> Int) -> [Int]
forall a b. (a -> b) -> a -> b
$ \case
(a
_, Constraint_Fixed Int
n) -> Int
n
(a
_, Constraint_Min Int
n) -> Int
n
leftover :: Int
leftover = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
available Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minTotal)
numStretch :: Int
numStretch = [(a, Constraint)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(a, Constraint)] -> Int) -> [(a, Constraint)] -> Int
forall a b. (a -> b) -> a -> b
$ ((a, Constraint) -> Bool) -> [(a, Constraint)] -> [(a, Constraint)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Constraint -> Bool
isMin (Constraint -> Bool)
-> ((a, Constraint) -> Constraint) -> (a, Constraint) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Constraint) -> Constraint
forall a b. (a, b) -> b
snd) [(a, Constraint)]
constraints
szStretch :: Int
szStretch = Ratio Int -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Ratio Int -> Int) -> Ratio Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
leftover Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
numStretch Int
1
adjustment :: Int
adjustment = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
available Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minTotal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
szStretch Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numStretch
in (Int, [(a, Int)]) -> [(a, Int)]
forall a b. (a, b) -> b
snd ((Int, [(a, Int)]) -> [(a, Int)])
-> (Int, [(a, Int)]) -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ (Int -> (a, Constraint) -> (Int, (a, Int)))
-> Int -> [(a, Constraint)] -> (Int, [(a, Int)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\Int
adj (a
a, Constraint
c) -> case Constraint
c of
Constraint_Fixed Int
n -> (Int
adj, (a
a, Int
n))
Constraint_Min Int
n -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
adjInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), (a
a, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szStretch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Num a => a -> a
signum Int
adj))) Int
adjustment [(a, Constraint)]
constraints
isMin :: Constraint -> Bool
isMin (Constraint_Min Int
_) = Bool
True
isMin Constraint
_ = Bool
False
chunk :: Orientation -> Region -> (Int, Int) -> Region
chunk :: Orientation -> Region -> (Int, Int) -> Region
chunk Orientation
o Region
r (Int
offset, Int
sz) = case Orientation
o of
Orientation
Orientation_Column -> Region
r
{ _region_top :: Int
_region_top = Region -> Int
_region_top Region
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset
, _region_height :: Int
_region_height = Int
sz
}
Orientation
Orientation_Row -> Region
r
{ _region_left :: Int
_region_left = Region -> Int
_region_left Region
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset
, _region_width :: Int
_region_width = Int
sz
}
class Monad m => HasLayout t m | m -> t where
axis :: Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
region :: Dynamic t Constraint -> m (Dynamic t Region)
askOrientation :: m (Dynamic t Orientation)
newtype Layout t m a = Layout
{ Layout t m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
unLayout :: DynamicWriterT t (LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m) a
}
deriving
( a -> Layout t m b -> Layout t m a
(a -> b) -> Layout t m a -> Layout t m b
(forall a b. (a -> b) -> Layout t m a -> Layout t m b)
-> (forall a b. a -> Layout t m b -> Layout t m a)
-> Functor (Layout t m)
forall a b. a -> Layout t m b -> Layout t m a
forall a b. (a -> b) -> Layout t m a -> Layout t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> Layout t m b -> Layout t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> Layout t m a -> Layout t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Layout t m b -> Layout t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> Layout t m b -> Layout t m a
fmap :: (a -> b) -> Layout t m a -> Layout t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> Layout t m a -> Layout t m b
Functor
, Functor (Layout t m)
a -> Layout t m a
Functor (Layout t m)
-> (forall a. a -> Layout t m a)
-> (forall a b.
Layout t m (a -> b) -> Layout t m a -> Layout t m b)
-> (forall a b c.
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c)
-> (forall a b. Layout t m a -> Layout t m b -> Layout t m b)
-> (forall a b. Layout t m a -> Layout t m b -> Layout t m a)
-> Applicative (Layout t m)
Layout t m a -> Layout t m b -> Layout t m b
Layout t m a -> Layout t m b -> Layout t m a
Layout t m (a -> b) -> Layout t m a -> Layout t m b
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
forall a. a -> Layout t m a
forall a b. Layout t m a -> Layout t m b -> Layout t m a
forall a b. Layout t m a -> Layout t m b -> Layout t m b
forall a b. Layout t m (a -> b) -> Layout t m a -> Layout t m b
forall a b c.
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
forall t (m :: * -> *). Monad m => Functor (Layout t m)
forall t (m :: * -> *) a. Monad m => a -> Layout t m a
forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m a
forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m b
forall t (m :: * -> *) a b.
Monad m =>
Layout t m (a -> b) -> Layout t m a -> Layout t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t 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
<* :: Layout t m a -> Layout t m b -> Layout t m a
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m a
*> :: Layout t m a -> Layout t m b -> Layout t m b
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m b
liftA2 :: (a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
<*> :: Layout t m (a -> b) -> Layout t m a -> Layout t m b
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m (a -> b) -> Layout t m a -> Layout t m b
pure :: a -> Layout t m a
$cpure :: forall t (m :: * -> *) a. Monad m => a -> Layout t m a
$cp1Applicative :: forall t (m :: * -> *). Monad m => Functor (Layout t m)
Applicative
, HasDisplayRegion t
, Applicative (Layout t m)
a -> Layout t m a
Applicative (Layout t m)
-> (forall a b.
Layout t m a -> (a -> Layout t m b) -> Layout t m b)
-> (forall a b. Layout t m a -> Layout t m b -> Layout t m b)
-> (forall a. a -> Layout t m a)
-> Monad (Layout t m)
Layout t m a -> (a -> Layout t m b) -> Layout t m b
Layout t m a -> Layout t m b -> Layout t m b
forall a. a -> Layout t m a
forall a b. Layout t m a -> Layout t m b -> Layout t m b
forall a b. Layout t m a -> (a -> Layout t m b) -> Layout t m b
forall t (m :: * -> *). Monad m => Applicative (Layout t m)
forall t (m :: * -> *) a. Monad m => a -> Layout t m a
forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m b
forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> (a -> Layout t m b) -> Layout t 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
return :: a -> Layout t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> Layout t m a
>> :: Layout t m a -> Layout t m b -> Layout t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m b
>>= :: Layout t m a -> (a -> Layout t m b) -> Layout t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> (a -> Layout t m b) -> Layout t m b
$cp1Monad :: forall t (m :: * -> *). Monad m => Applicative (Layout t m)
Monad
, Monad (Layout t m)
Monad (Layout t m)
-> (forall a. (a -> Layout t m a) -> Layout t m a)
-> MonadFix (Layout t m)
(a -> Layout t m a) -> Layout t m a
forall a. (a -> Layout t m a) -> Layout t m a
forall t (m :: * -> *). MonadFix m => Monad (Layout t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> Layout t m a) -> Layout t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> Layout t m a) -> Layout t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> Layout t m a) -> Layout t m a
$cp1MonadFix :: forall t (m :: * -> *). MonadFix m => Monad (Layout t m)
MonadFix
, MonadHold t
, Monad (Layout t m)
Monad (Layout t m)
-> (forall a. IO a -> Layout t m a) -> MonadIO (Layout t m)
IO a -> Layout t m a
forall a. IO a -> Layout t m a
forall t (m :: * -> *). MonadIO m => Monad (Layout t m)
forall t (m :: * -> *) a. MonadIO m => IO a -> Layout t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Layout t m a
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> Layout t m a
$cp1MonadIO :: forall t (m :: * -> *). MonadIO m => Monad (Layout t m)
MonadIO
, Monad (Layout t m)
Layout t m NodeId
Monad (Layout t m) -> Layout t m NodeId -> MonadNodeId (Layout t m)
forall t (m :: * -> *). MonadNodeId m => Monad (Layout t m)
forall t (m :: * -> *). MonadNodeId m => Layout t m NodeId
forall (m :: * -> *). Monad m -> m NodeId -> MonadNodeId m
getNextNodeId :: Layout t m NodeId
$cgetNextNodeId :: forall t (m :: * -> *). MonadNodeId m => Layout t m NodeId
$cp1MonadNodeId :: forall t (m :: * -> *). MonadNodeId m => Monad (Layout t m)
MonadNodeId
, MonadReflexCreateTrigger t
, MonadSample t
, NotReady t
, PerformEvent t
, PostBuild t
, TriggerEvent t
)
instance MonadTrans (Layout t) where
lift :: m a -> Layout t m a
lift = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a)
-> (m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a)
-> m a
-> Layout t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a)
-> (m a
-> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a)
-> m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MFunctor (Layout t) where
hoist :: (forall a. m a -> n a) -> Layout t m b -> Layout t n b
hoist forall a. m a -> n a
f = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n)
b
-> Layout t n b
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n)
b
-> Layout t n b)
-> (Layout t m b
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n)
b)
-> Layout t m b
-> Layout t n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a
-> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n a)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n)
b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. m a -> n a)
-> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a
-> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
f) (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n)
b)
-> (Layout t m b
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b)
-> Layout t m b
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n)
b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout t m b
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b
forall t (m :: * -> *) a.
Layout t m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
unLayout
instance (Adjustable t m, MonadFix m, MonadHold t m) => Adjustable t (Layout t m) where
runWithReplace :: Layout t m a -> Event t (Layout t m b) -> Layout t m (a, Event t b)
runWithReplace (Layout DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
a) Event t (Layout t m b)
e = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Event t b)
-> Layout t m (a, Event t b)
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Event t b)
-> Layout t m (a, Event t b))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Event t b)
-> Layout t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Event
t
(DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
a (Event
t
(DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Event t b))
-> Event
t
(DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Event t b)
forall a b. (a -> b) -> a -> b
$ (Layout t m b
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b)
-> Event t (Layout t m b)
-> Event
t
(DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Layout t m b
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
b
forall t (m :: * -> *) a.
Layout t m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
unLayout Event t (Layout t m b)
e
traverseIntMapWithKeyWithAdjust :: (Int -> v -> Layout t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> Layout t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Int -> v -> Layout t m v'
f IntMap v
m Event t (PatchIntMap v)
e = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(IntMap v', Event t (PatchIntMap v'))
-> Layout t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(IntMap v', Event t (PatchIntMap v'))
-> Layout t m (IntMap v', Event t (PatchIntMap v')))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(IntMap v', Event t (PatchIntMap v'))
-> Layout t m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$ (Int
-> v
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
v')
-> IntMap v
-> Event t (PatchIntMap v)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Int
k v
v -> Layout t m v'
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
v'
forall t (m :: * -> *) a.
Layout t m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
unLayout (Layout t m v'
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
v')
-> Layout t m v'
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
v'
forall a b. (a -> b) -> a -> b
$ Int -> v -> Layout t m v'
f Int
k v
v) IntMap v
m Event t (PatchIntMap v)
e
traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> Layout t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> Layout t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> Layout t m (v' a)
f DMap k v
m Event t (PatchDMap k v)
e = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(DMap k v', Event t (PatchDMap k v'))
-> Layout t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(DMap k v', Event t (PatchDMap k v'))
-> Layout t m (DMap k v', Event t (PatchDMap k v')))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(DMap k v', Event t (PatchDMap k v'))
-> Layout t m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ (forall a.
k a
-> v a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
k v a
v -> Layout t m (v' a)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(v' a)
forall t (m :: * -> *) a.
Layout t m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
unLayout (Layout t m (v' a)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(v' a))
-> Layout t m (v' a)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> Layout t m (v' a)
forall a. k a -> v a -> Layout t m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMap k v)
e
traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> Layout t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> Layout t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> Layout t m (v' a)
f DMap k v
m Event t (PatchDMapWithMove k v)
e = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(DMap k v', Event t (PatchDMapWithMove k v'))
-> Layout t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(DMap k v', Event t (PatchDMapWithMove k v'))
-> Layout t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(DMap k v', Event t (PatchDMapWithMove k v'))
-> Layout t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ (forall a.
k a
-> v a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
k v a
v -> Layout t m (v' a)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(v' a)
forall t (m :: * -> *) a.
Layout t m a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
unLayout (Layout t m (v' a)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(v' a))
-> Layout t m (v' a)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> Layout t m (v' a)
forall a. k a -> v a -> Layout t m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMapWithMove k v)
e
hoistRunLayout
:: (HasDisplayRegion t m, MonadFix m, Monad n)
=> (m a -> n b)
-> Layout t m a
-> Layout t n b
hoistRunLayout :: (m a -> n b) -> Layout t m a -> Layout t n b
hoistRunLayout m a -> n b
f Layout t m a
x = do
Dynamic t (LayoutTree (Region, Orientation))
solution <- DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n)
(Dynamic t (LayoutTree (Region, Orientation)))
-> Layout t n (Dynamic t (LayoutTree (Region, Orientation)))
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n)
(Dynamic t (LayoutTree (Region, Orientation)))
forall r (m :: * -> *). MonadReader r m => m r
ask
let orientation :: Dynamic t Orientation
orientation = (Region, Orientation) -> Orientation
forall a b. (a, b) -> b
snd ((Region, Orientation) -> Orientation)
-> (LayoutTree (Region, Orientation) -> (Region, Orientation))
-> LayoutTree (Region, Orientation)
-> Orientation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutTree (Region, Orientation) -> (Region, Orientation)
forall a. LayoutTree a -> a
rootLT (LayoutTree (Region, Orientation) -> Orientation)
-> Dynamic t (LayoutTree (Region, Orientation))
-> Dynamic t Orientation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (LayoutTree (Region, Orientation))
solution
n b -> Layout t n b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n b -> Layout t n b) -> n b -> Layout t n b
forall a b. (a -> b) -> a -> b
$ m a -> n b
f (m a -> n b) -> m a -> n b
forall a b. (a -> b) -> a -> b
$ do
Dynamic t Int
dw <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
Dynamic t Int
dh <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
let reg :: Dynamic t Region
reg = Int -> Int -> Int -> Int -> Region
Region Int
0 Int
0 (Int -> Int -> Region)
-> Dynamic t Int -> Dynamic t (Int -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dw Dynamic t (Int -> Region) -> Dynamic t Int -> Dynamic t Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
dh
Dynamic t Orientation -> Dynamic t Region -> Layout t m a -> m a
forall (m :: * -> *) t a.
(MonadFix m, Reflex t) =>
Dynamic t Orientation -> Dynamic t Region -> Layout t m a -> m a
runLayout Dynamic t Orientation
orientation Dynamic t Region
reg Layout t m a
x
instance (HasInput t m, HasDisplayRegion t m, MonadFix m, Reflex t) => HasInput t (Layout t m) where
localInput :: (Event t VtyEvent -> Event t VtyEvent)
-> Layout t m a -> Layout t m a
localInput = (m a -> m a) -> Layout t m a -> Layout t m a
forall t (m :: * -> *) (n :: * -> *) a b.
(HasDisplayRegion t m, MonadFix m, Monad n) =>
(m a -> n b) -> Layout t m a -> Layout t n b
hoistRunLayout ((m a -> m a) -> Layout t m a -> Layout t m a)
-> ((Event t VtyEvent -> Event t VtyEvent) -> m a -> m a)
-> (Event t VtyEvent -> Event t VtyEvent)
-> Layout t m a
-> Layout t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event t VtyEvent -> Event t VtyEvent) -> m a -> m a
forall k (t :: k) (m :: * -> *) a.
HasInput t m =>
(Event t VtyEvent -> Event t VtyEvent) -> m a -> m a
localInput
instance (HasDisplayRegion t m, HasImageWriter t m, MonadFix m) => HasImageWriter t (Layout t m) where
mapImages :: (Behavior t [Image] -> Behavior t [Image])
-> Layout t m a -> Layout t m a
mapImages Behavior t [Image] -> Behavior t [Image]
f = (m a -> m a) -> Layout t m a -> Layout t m a
forall t (m :: * -> *) (n :: * -> *) a b.
(HasDisplayRegion t m, MonadFix m, Monad n) =>
(m a -> n b) -> Layout t m a -> Layout t n b
hoistRunLayout ((Behavior t [Image] -> Behavior t [Image]) -> m a -> m a
forall k (t :: k) (m :: * -> *) a.
HasImageWriter t m =>
(Behavior t [Image] -> Behavior t [Image]) -> m a -> m a
mapImages Behavior t [Image] -> Behavior t [Image]
f)
instance (HasFocusReader t m, Monad m) => HasFocusReader t (Layout t m)
instance (HasTheme t m, Monad m) => HasTheme t (Layout t m)
instance (Monad m, MonadNodeId m, Reflex t, MonadFix m) => HasLayout t (Layout t m) where
axis :: Dynamic t Orientation
-> Dynamic t Constraint -> Layout t m a -> Layout t m a
axis Dynamic t Orientation
o Dynamic t Constraint
c (Layout DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
x) = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
forall a b. (a -> b) -> a -> b
$ do
NodeId
nodeId <- DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
NodeId
forall (m :: * -> *). MonadNodeId m => m NodeId
getNextNodeId
let dummyParentLayout :: LayoutTree (Region, Orientation)
dummyParentLayout = (Region, Orientation)
-> LayoutForest (Region, Orientation)
-> LayoutTree (Region, Orientation)
forall a. a -> LayoutForest a -> LayoutTree a
LayoutTree (Region
nilRegion, Orientation
Orientation_Column) LayoutForest (Region, Orientation)
forall a. Monoid a => a
mempty
(a
result, Dynamic t (LayoutForest (Constraint, Orientation))
forest) <- ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Dynamic t (LayoutForest (Constraint, Orientation))))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall a b. (a -> b) -> a -> b
$ (Dynamic t (LayoutTree (Region, Orientation))
-> Dynamic t (LayoutTree (Region, Orientation)))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Dynamic t (LayoutTree (Region, Orientation))
t -> LayoutTree (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation))
-> LayoutTree (Region, Orientation)
forall a. a -> Maybe a -> a
fromMaybe LayoutTree (Region, Orientation)
dummyParentLayout (Maybe (LayoutTree (Region, Orientation))
-> LayoutTree (Region, Orientation))
-> (LayoutTree (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation)))
-> LayoutTree (Region, Orientation)
-> LayoutTree (Region, Orientation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeId
-> LayoutForest (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation))
forall a. NodeId -> LayoutForest a -> Maybe (LayoutTree a)
lookupLF NodeId
nodeId (LayoutForest (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation)))
-> (LayoutTree (Region, Orientation)
-> LayoutForest (Region, Orientation))
-> LayoutTree (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutTree (Region, Orientation)
-> LayoutForest (Region, Orientation)
forall a. LayoutTree a -> LayoutForest a
childrenLT (LayoutTree (Region, Orientation)
-> LayoutTree (Region, Orientation))
-> Dynamic t (LayoutTree (Region, Orientation))
-> Dynamic t (LayoutTree (Region, Orientation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (LayoutTree (Region, Orientation))
t) (ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation))))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall a b. (a -> b) -> a -> b
$ DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall (m :: * -> *) t w a.
(MonadFix m, Reflex t, Monoid w) =>
DynamicWriterT t w m a -> m (a, Dynamic t w)
runDynamicWriterT DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
x
Dynamic t (LayoutForest (Constraint, Orientation))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
()
forall t w (m :: * -> *).
DynamicWriter t w m =>
Dynamic t w -> m ()
tellDyn (Dynamic t (LayoutForest (Constraint, Orientation))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
())
-> Dynamic t (LayoutForest (Constraint, Orientation))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
()
forall a b. (a -> b) -> a -> b
$ NodeId
-> LayoutTree (Constraint, Orientation)
-> LayoutForest (Constraint, Orientation)
forall a. NodeId -> LayoutTree a -> LayoutForest a
singletonLF NodeId
nodeId (LayoutTree (Constraint, Orientation)
-> LayoutForest (Constraint, Orientation))
-> Dynamic t (LayoutTree (Constraint, Orientation))
-> Dynamic t (LayoutForest (Constraint, Orientation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Constraint, Orientation)
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Constraint, Orientation)
forall a. a -> LayoutForest a -> LayoutTree a
LayoutTree ((Constraint, Orientation)
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Constraint, Orientation))
-> Dynamic t (Constraint, Orientation)
-> Dynamic
t
(LayoutForest (Constraint, Orientation)
-> LayoutTree (Constraint, Orientation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Constraint -> Orientation -> (Constraint, Orientation))
-> Dynamic t Constraint
-> Dynamic t (Orientation -> (Constraint, Orientation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Constraint
c Dynamic t (Orientation -> (Constraint, Orientation))
-> Dynamic t Orientation -> Dynamic t (Constraint, Orientation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Orientation
o) Dynamic
t
(LayoutForest (Constraint, Orientation)
-> LayoutTree (Constraint, Orientation))
-> Dynamic t (LayoutForest (Constraint, Orientation))
-> Dynamic t (LayoutTree (Constraint, Orientation))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t (LayoutForest (Constraint, Orientation))
forest)
a
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
region :: Dynamic t Constraint -> Layout t m (Dynamic t Region)
region Dynamic t Constraint
c = do
NodeId
nodeId <- m NodeId -> Layout t m NodeId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m NodeId
forall (m :: * -> *). MonadNodeId m => m NodeId
getNextNodeId
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
()
-> Layout t m ()
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
()
-> Layout t m ())
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
()
-> Layout t m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t (LayoutForest (Constraint, Orientation))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
()
forall t w (m :: * -> *).
DynamicWriter t w m =>
Dynamic t w -> m ()
tellDyn (Dynamic t (LayoutForest (Constraint, Orientation))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
())
-> Dynamic t (LayoutForest (Constraint, Orientation))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
()
forall a b. (a -> b) -> a -> b
$ Dynamic t Constraint
-> (Constraint -> LayoutForest (Constraint, Orientation))
-> Dynamic t (LayoutForest (Constraint, Orientation))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Constraint
c ((Constraint -> LayoutForest (Constraint, Orientation))
-> Dynamic t (LayoutForest (Constraint, Orientation)))
-> (Constraint -> LayoutForest (Constraint, Orientation))
-> Dynamic t (LayoutForest (Constraint, Orientation))
forall a b. (a -> b) -> a -> b
$ \Constraint
c' -> NodeId
-> LayoutTree (Constraint, Orientation)
-> LayoutForest (Constraint, Orientation)
forall a. NodeId -> LayoutTree a -> LayoutForest a
singletonLF NodeId
nodeId (LayoutTree (Constraint, Orientation)
-> LayoutForest (Constraint, Orientation))
-> LayoutTree (Constraint, Orientation)
-> LayoutForest (Constraint, Orientation)
forall a b. (a -> b) -> a -> b
$ (Constraint, Orientation)
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Constraint, Orientation)
forall a. a -> LayoutForest a -> LayoutTree a
LayoutTree (Constraint
c', Orientation
Orientation_Row) LayoutForest (Constraint, Orientation)
forall a. Monoid a => a
mempty
Dynamic t (LayoutTree (Region, Orientation))
solutions <- DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t (LayoutTree (Region, Orientation)))
-> Layout t m (Dynamic t (LayoutTree (Region, Orientation)))
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t (LayoutTree (Region, Orientation)))
forall r (m :: * -> *). MonadReader r m => m r
ask
Dynamic t Region -> Layout t m (Dynamic t Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dynamic t Region -> Layout t m (Dynamic t Region))
-> Dynamic t Region -> Layout t m (Dynamic t Region)
forall a b. (a -> b) -> a -> b
$ Region
-> (LayoutTree (Region, Orientation) -> Region)
-> Maybe (LayoutTree (Region, Orientation))
-> Region
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Region
nilRegion ((Region, Orientation) -> Region
forall a b. (a, b) -> a
fst ((Region, Orientation) -> Region)
-> (LayoutTree (Region, Orientation) -> (Region, Orientation))
-> LayoutTree (Region, Orientation)
-> Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutTree (Region, Orientation) -> (Region, Orientation)
forall a. LayoutTree a -> a
rootLT) (Maybe (LayoutTree (Region, Orientation)) -> Region)
-> (LayoutTree (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation)))
-> LayoutTree (Region, Orientation)
-> Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeId
-> LayoutForest (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation))
forall a. NodeId -> LayoutForest a -> Maybe (LayoutTree a)
lookupLF NodeId
nodeId (LayoutForest (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation)))
-> (LayoutTree (Region, Orientation)
-> LayoutForest (Region, Orientation))
-> LayoutTree (Region, Orientation)
-> Maybe (LayoutTree (Region, Orientation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutTree (Region, Orientation)
-> LayoutForest (Region, Orientation)
forall a. LayoutTree a -> LayoutForest a
childrenLT (LayoutTree (Region, Orientation) -> Region)
-> Dynamic t (LayoutTree (Region, Orientation)) -> Dynamic t Region
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (LayoutTree (Region, Orientation))
solutions
askOrientation :: Layout t m (Dynamic t Orientation)
askOrientation = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t Orientation)
-> Layout t m (Dynamic t Orientation)
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t Orientation)
-> Layout t m (Dynamic t Orientation))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t Orientation)
-> Layout t m (Dynamic t Orientation)
forall a b. (a -> b) -> a -> b
$ (Dynamic t (LayoutTree (Region, Orientation))
-> Dynamic t Orientation)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t Orientation)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Dynamic t (LayoutTree (Region, Orientation))
-> Dynamic t Orientation)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t Orientation))
-> (Dynamic t (LayoutTree (Region, Orientation))
-> Dynamic t Orientation)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t Orientation)
forall a b. (a -> b) -> a -> b
$ (LayoutTree (Region, Orientation) -> Orientation)
-> Dynamic t (LayoutTree (Region, Orientation))
-> Dynamic t Orientation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Region, Orientation) -> Orientation
forall a b. (a, b) -> b
snd ((Region, Orientation) -> Orientation)
-> (LayoutTree (Region, Orientation) -> (Region, Orientation))
-> LayoutTree (Region, Orientation)
-> Orientation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutTree (Region, Orientation) -> (Region, Orientation)
forall a. LayoutTree a -> a
rootLT)
instance (MonadFix m, HasFocus t m) => HasFocus t (Layout t m) where
makeFocus :: Layout t m FocusId
makeFocus = m FocusId -> Layout t m FocusId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FocusId
forall k (t :: k) (m :: * -> *). HasFocus t m => m FocusId
makeFocus
requestFocus :: Event t Refocus -> Layout t m ()
requestFocus = m () -> Layout t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Layout t m ())
-> (Event t Refocus -> m ()) -> Event t Refocus -> Layout t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t Refocus -> m ()
forall k (t :: k) (m :: * -> *).
HasFocus t m =>
Event t Refocus -> m ()
requestFocus
isFocused :: FocusId -> Layout t m (Dynamic t Bool)
isFocused = m (Dynamic t Bool) -> Layout t m (Dynamic t Bool)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t Bool) -> Layout t m (Dynamic t Bool))
-> (FocusId -> m (Dynamic t Bool))
-> FocusId
-> Layout t m (Dynamic t Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusId -> m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *).
HasFocus t m =>
FocusId -> m (Dynamic t Bool)
isFocused
focusedId :: Layout t m (Dynamic t (Maybe FocusId))
focusedId = m (Dynamic t (Maybe FocusId))
-> Layout t m (Dynamic t (Maybe FocusId))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Dynamic t (Maybe FocusId))
forall k (t :: k) (m :: * -> *).
HasFocus t m =>
m (Dynamic t (Maybe FocusId))
focusedId
subFoci :: Layout t m a -> Layout t m (a, Dynamic t FocusSet)
subFoci (Layout DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
x) = DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Dynamic t FocusSet)
-> Layout t m (a, Dynamic t FocusSet)
forall t (m :: * -> *) a.
DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> Layout t m a
Layout (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Dynamic t FocusSet)
-> Layout t m (a, Dynamic t FocusSet))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Dynamic t FocusSet)
-> Layout t m (a, Dynamic t FocusSet)
forall a b. (a -> b) -> a -> b
$ do
Dynamic t (LayoutTree (Region, Orientation))
y <- DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(Dynamic t (LayoutTree (Region, Orientation)))
forall r (m :: * -> *). MonadReader r m => m r
ask
((a
a, Dynamic t (LayoutForest (Constraint, Orientation))
w), Dynamic t FocusSet
sf) <- ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
forall a b. (a -> b) -> a -> b
$ m ((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet))
-> m ((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
forall a b. (a -> b) -> a -> b
$ m (a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> m ((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
forall k (t :: k) (m :: * -> *) a.
HasFocus t m =>
m a -> m (a, Dynamic t FocusSet)
subFoci (m (a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> m ((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet))
-> m (a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> m ((a, Dynamic t (LayoutForest (Constraint, Orientation))),
Dynamic t FocusSet)
forall a b. (a -> b) -> a -> b
$ (ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> Dynamic t (LayoutTree (Region, Orientation))
-> m (a, Dynamic t (LayoutForest (Constraint, Orientation))))
-> Dynamic t (LayoutTree (Region, Orientation))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> m (a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> Dynamic t (LayoutTree (Region, Orientation))
-> m (a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Dynamic t (LayoutTree (Region, Orientation))
y (ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> m (a, Dynamic t (LayoutForest (Constraint, Orientation))))
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> m (a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall a b. (a -> b) -> a -> b
$ DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall (m :: * -> *) t w a.
(MonadFix m, Reflex t, Monoid w) =>
DynamicWriterT t w m a -> m (a, Dynamic t w)
runDynamicWriterT DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
x
Dynamic t (LayoutForest (Constraint, Orientation))
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
()
forall t w (m :: * -> *).
DynamicWriter t w m =>
Dynamic t w -> m ()
tellDyn Dynamic t (LayoutForest (Constraint, Orientation))
w
(a, Dynamic t FocusSet)
-> DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
(a, Dynamic t FocusSet)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Dynamic t FocusSet
sf)
runLayout
:: (MonadFix m, Reflex t)
=> Dynamic t Orientation
-> Dynamic t Region
-> Layout t m a
-> m a
runLayout :: Dynamic t Orientation -> Dynamic t Region -> Layout t m a -> m a
runLayout Dynamic t Orientation
o Dynamic t Region
r (Layout DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
x) = do
rec (a
result, Dynamic t (LayoutForest (Constraint, Orientation))
w) <- ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
-> Dynamic t (LayoutTree (Region, Orientation))
-> m (a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
-> ReaderT
(Dynamic t (LayoutTree (Region, Orientation)))
m
(a, Dynamic t (LayoutForest (Constraint, Orientation)))
forall (m :: * -> *) t w a.
(MonadFix m, Reflex t, Monoid w) =>
DynamicWriterT t w m a -> m (a, Dynamic t w)
runDynamicWriterT DynamicWriterT
t
(LayoutForest (Constraint, Orientation))
(ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
a
x) Dynamic t (LayoutTree (Region, Orientation))
solutions
let solutions :: Dynamic t (LayoutTree (Region, Orientation))
solutions = Orientation
-> Region
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation)
solve (Orientation
-> Region
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation))
-> Dynamic t Orientation
-> Dynamic
t
(Region
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Orientation
o Dynamic
t
(Region
-> LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation))
-> Dynamic t Region
-> Dynamic
t
(LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Region
r Dynamic
t
(LayoutForest (Constraint, Orientation)
-> LayoutTree (Region, Orientation))
-> Dynamic t (LayoutForest (Constraint, Orientation))
-> Dynamic t (LayoutTree (Region, Orientation))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t (LayoutForest (Constraint, Orientation))
w
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
initLayout :: (HasDisplayRegion t m, MonadFix m) => Layout t m a -> m a
initLayout :: Layout t m a -> m a
initLayout Layout t m a
f = do
Dynamic t Int
dw <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
Dynamic t Int
dh <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
let r :: Dynamic t Region
r = Int -> Int -> Int -> Int -> Region
Region Int
0 Int
0 (Int -> Int -> Region)
-> Dynamic t Int -> Dynamic t (Int -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dw Dynamic t (Int -> Region) -> Dynamic t Int -> Dynamic t Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
dh
Dynamic t Orientation -> Dynamic t Region -> Layout t m a -> m a
forall (m :: * -> *) t a.
(MonadFix m, Reflex t) =>
Dynamic t Orientation -> Dynamic t Region -> Layout t m a -> m a
runLayout (Orientation -> Dynamic t Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Orientation_Column) Dynamic t Region
r Layout t m a
f
initManager
:: (HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m)
=> Layout t (Focus t m) a
-> m (a, Dynamic t FocusSet)
initManager :: Layout t (Focus t m) a -> m (a, Dynamic t FocusSet)
initManager =
Focus t m a -> m (a, Dynamic t FocusSet)
forall (m :: * -> *) t a.
(MonadFix m, MonadHold t m, Reflex t) =>
Focus t m a -> m (a, Dynamic t FocusSet)
runFocus (Focus t m a -> m (a, Dynamic t FocusSet))
-> (Layout t (Focus t m) a -> Focus t m a)
-> Layout t (Focus t m) a
-> m (a, Dynamic t FocusSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout t (Focus t m) a -> Focus t m a
forall t (m :: * -> *) a.
(HasDisplayRegion t m, MonadFix m) =>
Layout t m a -> m a
initLayout
initManager_
:: (HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m)
=> Layout t (Focus t m) a
-> m a
initManager_ :: Layout t (Focus t m) a -> m a
initManager_ = ((a, Dynamic t FocusSet) -> a) -> m (a, Dynamic t FocusSet) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Dynamic t FocusSet) -> a
forall a b. (a, b) -> a
fst (m (a, Dynamic t FocusSet) -> m a)
-> (Layout t (Focus t m) a -> m (a, Dynamic t FocusSet))
-> Layout t (Focus t m) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout t (Focus t m) a -> m (a, Dynamic t FocusSet)
forall t (m :: * -> *) a.
(HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m) =>
Layout t (Focus t m) a -> m (a, Dynamic t FocusSet)
initManager
tile'
:: (MonadFix m, MonadHold t m, HasInput t m, HasFocus t m, HasLayout t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)
=> Dynamic t Constraint
-> m a
-> m (FocusId, a)
tile' :: Dynamic t Constraint -> m a -> m (FocusId, a)
tile' Dynamic t Constraint
c m a
w = do
FocusId
fid <- m FocusId
forall k (t :: k) (m :: * -> *). HasFocus t m => m FocusId
makeFocus
Dynamic t Region
r <- Dynamic t Constraint -> m (Dynamic t Region)
forall k (t :: k) (m :: * -> *).
HasLayout t m =>
Dynamic t Constraint -> m (Dynamic t Region)
region Dynamic t Constraint
c
Dynamic t Bool
parentFocused <- FocusId -> m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *).
HasFocus t m =>
FocusId -> m (Dynamic t Bool)
isFocused FocusId
fid
rec (Event t MouseDown
click, a
result, Dynamic t Bool
childFocused) <- Dynamic t Region
-> Dynamic t Bool
-> m (Event t MouseDown, a, Dynamic t Bool)
-> m (Event t MouseDown, a, Dynamic t Bool)
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m,
HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Region -> Dynamic t Bool -> m a -> m a
pane Dynamic t Region
r Dynamic t Bool
focused (m (Event t MouseDown, a, Dynamic t Bool)
-> m (Event t MouseDown, a, Dynamic t Bool))
-> m (Event t MouseDown, a, Dynamic t Bool)
-> m (Event t MouseDown, a, Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ (Dynamic t Bool -> m (Event t MouseDown, a, Dynamic t Bool))
-> m (Event t MouseDown, a, Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(HasFocus t m, MonadFix m) =>
(Dynamic t Bool -> m a) -> m a
anyChildFocused ((Dynamic t Bool -> m (Event t MouseDown, a, Dynamic t Bool))
-> m (Event t MouseDown, a, Dynamic t Bool))
-> (Dynamic t Bool -> m (Event t MouseDown, a, Dynamic t Bool))
-> m (Event t MouseDown, a, Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ \Dynamic t Bool
childFoc -> do
Event t MouseDown
m <- Button -> m (Event t MouseDown)
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
Button -> m (Event t MouseDown)
mouseDown Button
V.BLeft
a
x <- m a
w
(Event t MouseDown, a, Dynamic t Bool)
-> m (Event t MouseDown, a, Dynamic t Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event t MouseDown
m, a
x, Dynamic t Bool
childFoc)
let focused :: Dynamic t Bool
focused = Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool)
-> Dynamic t Bool -> Dynamic t (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Bool
parentFocused Dynamic t (Bool -> Bool) -> Dynamic t Bool -> Dynamic t Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Bool
childFocused
Event t Refocus -> m ()
forall k (t :: k) (m :: * -> *).
HasFocus t m =>
Event t Refocus -> m ()
requestFocus (Event t Refocus -> m ()) -> Event t Refocus -> m ()
forall a b. (a -> b) -> a -> b
$ FocusId -> Refocus
Refocus_Id FocusId
fid Refocus -> Event t MouseDown -> Event t Refocus
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
click
(FocusId, a) -> m (FocusId, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FocusId
fid, a
result)
tile
:: (MonadFix m, MonadHold t m, HasInput t m, HasFocus t m, HasLayout t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)
=> Dynamic t Constraint
-> m a
-> m a
tile :: Dynamic t Constraint -> m a -> m a
tile Dynamic t Constraint
c = ((FocusId, a) -> a) -> m (FocusId, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FocusId, a) -> a
forall a b. (a, b) -> b
snd (m (FocusId, a) -> m a) -> (m a -> m (FocusId, a)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic t Constraint -> m a -> m (FocusId, a)
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m (FocusId, a)
tile' Dynamic t Constraint
c
grout
:: (MonadFix m, MonadHold t m, HasLayout t m, HasInput t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)
=> Dynamic t Constraint
-> m a
-> m a
grout :: Dynamic t Constraint -> m a -> m a
grout Dynamic t Constraint
c m a
w = do
Dynamic t Region
r <- Dynamic t Constraint -> m (Dynamic t Region)
forall k (t :: k) (m :: * -> *).
HasLayout t m =>
Dynamic t Constraint -> m (Dynamic t Region)
region Dynamic t Constraint
c
Dynamic t Region -> Dynamic t Bool -> m a -> m a
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m,
HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Region -> Dynamic t Bool -> m a -> m a
pane Dynamic t Region
r (Bool -> Dynamic t Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) m a
w