{-|
Module: Reflex.Vty.Widget.Layout
Description: Monad transformer and tools for arranging widgets and building screen layouts
-}
{-# 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
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

-- * Focus
--
-- $focus
--
-- The focus monad tracks which element is currently focused and processes
-- requests to change focus. Focusable elements are assigned a 'FocusId' and
-- can manually request focus or receive focus due to some other action (e.g.,
-- a tab press in a sibling element, a click event).
--
-- Focusable elements will usually be created via 'tile', but can also be
-- constructed via 'makeFocus' in 'HasFocus'. The latter option allows for
-- more find-grained control of focus behavior.

-- ** Storing focus state

-- | Identifies an element that is focusable. Can be created using 'makeFocus'.
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
$c== :: FocusId -> FocusId -> Bool
== :: FocusId -> FocusId -> Bool
$c/= :: FocusId -> FocusId -> Bool
/= :: 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
$ccompare :: FocusId -> FocusId -> Ordering
compare :: FocusId -> FocusId -> Ordering
$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
>= :: FocusId -> FocusId -> Bool
$cmax :: FocusId -> FocusId -> FocusId
max :: FocusId -> FocusId -> FocusId
$cmin :: FocusId -> FocusId -> FocusId
min :: FocusId -> FocusId -> FocusId
Ord)

-- | An ordered set of focus identifiers. The order here determines the order
-- in which focus cycles between focusable elements.
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

-- | Produces a 'FocusSet' with a single element
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

-- ** Changing focus state

-- | Operations that change the currently focused element.
data Refocus = Refocus_Shift Int -- ^ Shift the focus by a certain number of positions (see 'shiftFS')
             | Refocus_Id FocusId -- ^ Focus a particular element
             | Refocus_Clear -- ^ Remove focus from all elements

-- | Given a 'FocusSet', a currently focused element, and a number of positions
-- to move by, determine the newly focused element.
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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OSet FocusId -> Maybe (OSet FocusId)
forall a. a -> Maybe a
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)

-- ** The focus management monad

-- | A class for things that can produce focusable elements.
class (Monad m, Reflex t) => HasFocus t m | m -> t where
  -- | Create a focusable element.
  makeFocus :: m FocusId
  -- | Emit an 'Event' of requests to change the focus.
  requestFocus :: Event t Refocus -> m ()
  -- | Produce a 'Dynamic' that indicates whether the given 'FocusId' is focused.
  isFocused :: FocusId -> m (Dynamic t Bool)
  -- | Run an action, additionally returning the focusable elements it produced.
  subFoci :: m a -> m (a, Dynamic t FocusSet)
  -- | Get a 'Dynamic' of the currently focused element identifier.
  focusedId :: m (Dynamic t (Maybe FocusId))

-- | A monad transformer that keeps track of the set of focusable elements and
-- which, if any, are currently focused, and allows focus requests.
newtype Focus t m a = Focus
  { forall t (m :: * -> *) a.
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
    ( (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
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> Focus t m a -> Focus t m b
fmap :: forall a b. (a -> b) -> Focus t m a -> Focus t m b
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> Focus t m b -> Focus t m a
<$ :: forall a b. a -> Focus t m b -> Focus t m a
Functor
    , Functor (Focus t m)
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)
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
$cpure :: forall t (m :: * -> *) a. Monad m => a -> Focus t m a
pure :: forall a. a -> Focus t m a
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
Focus t m (a -> b) -> Focus t m a -> Focus t m b
<*> :: forall a b. Focus t m (a -> b) -> Focus t m a -> Focus t m b
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Focus t m a -> Focus t m b -> Focus t m c
liftA2 :: forall a b c.
(a -> b -> c) -> Focus t m a -> Focus t m b -> Focus t m c
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
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 b
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
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 a
Applicative
    , Applicative (Focus t m)
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)
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
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
Focus t m a -> (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
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
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 b
$creturn :: forall t (m :: * -> *) a. Monad m => a -> Focus t m a
return :: forall a. a -> Focus t m a
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)
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
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> Focus t m a) -> Focus t m a
mfix :: forall a. (a -> Focus t m a) -> Focus t m a
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
$cgetNextNodeId :: forall t (m :: * -> *). MonadNodeId m => Focus t m NodeId
getNextNodeId :: Focus t m NodeId
MonadNodeId
    , Monad (Focus t m)
Monad (Focus t m) =>
(forall a. IO a -> Focus t m a) -> MonadIO (Focus t m)
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
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> Focus t m a
liftIO :: forall a. IO a -> Focus t m a
MonadIO
    )


instance MonadTrans (Focus t) where
  lift :: forall (m :: * -> *) a. Monad m => 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 (m :: * -> *) a.
Monad m =>
m a -> DynamicWriterT t FocusSet 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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Dynamic t (Maybe FocusId)) 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 (m :: * -> *) a.
Monad m =>
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 (m :: * -> *) (n :: * -> *) b.
Monad m =>
(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
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> DynamicWriterT t FocusSet m b -> DynamicWriterT t FocusSet 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
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ReaderT (Dynamic t (Maybe FocusId)) m b
-> ReaderT (Dynamic t (Maybe FocusId)) 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
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> EventWriterT t (First Refocus) m b
-> EventWriterT t (First Refocus) n b
hoist m a -> n a
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 :: forall a b.
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 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 a b. (a -> b) -> Event t a -> Event t 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 :: forall v v'.
(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 v v'.
(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 (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
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 (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
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 :: forall a.
(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
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Focus t m b -> Focus t n b
hoist ((Event t VtyEvent -> Event t VtyEvent) -> m a -> m a
forall a. (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 :: forall a.
(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
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Focus t m b -> Focus t n b
hoist ((Behavior t [Image] -> Behavior t [Image]) -> m a -> m a
forall a. (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 (m :: * -> *) a. Monad m => m a -> Focus t m a
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 a. a -> Dynamic t a
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 a. a -> Focus t m a
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 a b. (a -> b) -> Event t a -> Event t b
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 a. a -> Focus t m a
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 :: forall a. 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 (m :: * -> *) a.
Monad m =>
m a -> DynamicWriterT t FocusSet 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, 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 a.
a
-> DynamicWriterT
     t
     FocusSet
     (ReaderT
        (Dynamic t (Maybe FocusId)) (EventWriterT t (First Refocus) m))
     a
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

-- | Runs a 'Focus' action, maintaining the selection state internally.
runFocus
  :: (MonadFix m, MonadHold t m, Reflex t)
  => Focus t m a
  -> m (a, Dynamic t FocusSet)
runFocus :: forall (m :: * -> *) t a.
(MonadFix m, MonadHold t m, Reflex t) =>
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 a. Dynamic t a -> Behavior t a
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 a. a -> m a
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

-- | Runs an action in the focus monad, providing it with information about
-- whether any of the foci created within it are focused.
anyChildFocused
  :: (HasFocus t m, MonadFix m)
  => (Dynamic t Bool -> m a)
  -> m a
anyChildFocused :: forall {k} (t :: k) (m :: * -> *) a.
(HasFocus t m, MonadFix m) =>
(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 a. 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 a b c.
(a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- ** Focus controls

-- | Request focus be shifted backward and forward based on tab presses. <Tab>
-- shifts focus forward and <Shift+Tab> shifts focus backward.
tabNavigation :: (Reflex t, HasInput t m, HasFocus t m) => m ()
tabNavigation :: forall {k} (t :: k) (m :: * -> *).
(Reflex t, HasInput t m, HasFocus t m) =>
m ()
tabNavigation = do
  Event t Int
fwd <- (KeyCombo -> Int) -> Event t KeyCombo -> Event t Int
forall a b. (a -> b) -> Event t a -> Event t b
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 a b. (a -> b) -> Event t a -> Event t b
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]

-- * Layout
--
-- $layout
-- The layout monad keeps track of a tree of elements, each having its own
-- layout constraints and orientation. Given the available rendering space, it
-- computes a layout solution and provides child elements with their particular
-- layout solution (the width and height of their rendering space).
--
-- Complex layouts are built up though some combination of:
--
-- - 'axis', which lays out its children in a particular orientation, and
-- - 'region', which "claims" some part of the screen according to its constraints
--

-- ** Layout restrictions

-- *** Constraints

-- | Datatype representing constraints on a widget's size along the main axis (see 'Orientation')
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
$cshowsPrec :: Int -> Constraint -> ShowS
showsPrec :: Int -> Constraint -> ShowS
$cshow :: Constraint -> String
show :: Constraint -> String
$cshowList :: [Constraint] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Constraint
readsPrec :: Int -> ReadS Constraint
$creadList :: ReadS [Constraint]
readList :: ReadS [Constraint]
$creadPrec :: ReadPrec Constraint
readPrec :: ReadPrec Constraint
$creadListPrec :: ReadPrec [Constraint]
readListPrec :: ReadPrec [Constraint]
Read, Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
/= :: 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
$ccompare :: Constraint -> Constraint -> Ordering
compare :: Constraint -> Constraint -> Ordering
$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
>= :: Constraint -> Constraint -> Bool
$cmax :: Constraint -> Constraint -> Constraint
max :: Constraint -> Constraint -> Constraint
$cmin :: Constraint -> Constraint -> Constraint
min :: Constraint -> Constraint -> Constraint
Ord)

-- | Shorthand for constructing a fixed constraint
fixed
  :: Reflex t
  => Dynamic t Int
  -> Dynamic t Constraint
fixed :: forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed = (Int -> Constraint) -> Dynamic t Int -> Dynamic t Constraint
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Constraint
Constraint_Fixed

-- | Shorthand for constructing a minimum size constraint
stretch
  :: Reflex t
  => Dynamic t Int
  -> Dynamic t Constraint
stretch :: forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch = (Int -> Constraint) -> Dynamic t Int -> Dynamic t Constraint
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Constraint
Constraint_Min

-- | Shorthand for constructing a constraint of no minimum size
flex
  :: Reflex t
  => Dynamic t Constraint
flex :: forall {k} (t :: k). Reflex t => Dynamic t Constraint
flex = Constraint -> Dynamic t Constraint
forall a. a -> Dynamic t a
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

-- *** Orientation

-- | The main-axis orientation of a 'Layout' widget
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
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> String
show :: Orientation -> String
$cshowList :: [Orientation] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Orientation
readsPrec :: Int -> ReadS Orientation
$creadList :: ReadS [Orientation]
readList :: ReadS [Orientation]
$creadPrec :: ReadPrec Orientation
readPrec :: ReadPrec Orientation
$creadListPrec :: ReadPrec [Orientation]
readListPrec :: ReadPrec [Orientation]
Read, Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: 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
$ccompare :: Orientation -> Orientation -> Ordering
compare :: Orientation -> Orientation -> Ordering
$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
>= :: Orientation -> Orientation -> Bool
$cmax :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
min :: Orientation -> Orientation -> Orientation
Ord)

-- | Create a row-oriented 'axis'
row
  :: (Reflex t, MonadFix m, HasLayout t m)
  => m a
  -> m a
row :: forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row = Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
forall a.
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 a. a -> Dynamic t a
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

-- | Create a column-oriented 'axis'
col
  :: (Reflex t, MonadFix m, HasLayout t m)
  => m a
  -> m a
col :: forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col = Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
forall a.
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 a. a -> Dynamic t a
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

-- ** Layout management data

-- | A collection of information related to the layout of the screen. The root
-- node is a "parent" widget, and the contents of the 'LayoutForest' are its
-- children.
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
$cshowsPrec :: forall a. Show a => Int -> LayoutTree a -> ShowS
showsPrec :: Int -> LayoutTree a -> ShowS
$cshow :: forall a. Show a => LayoutTree a -> String
show :: LayoutTree a -> String
$cshowList :: forall a. Show a => [LayoutTree a] -> ShowS
showList :: [LayoutTree a] -> ShowS
Show)

-- | An ordered, indexed collection of 'LayoutTree's representing information
-- about the children of some widget.
newtype LayoutForest a = LayoutForest { forall a. 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
$cshowsPrec :: forall a. Show a => Int -> LayoutForest a -> ShowS
showsPrec :: Int -> LayoutForest a -> ShowS
$cshow :: forall a. Show a => LayoutForest a -> String
show :: LayoutForest a -> String
$cshowList :: forall a. Show a => [LayoutForest a] -> ShowS
showList :: [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

-- | Perform a lookup by 'NodeId' in a 'LayoutForest'
lookupLF :: NodeId -> LayoutForest a -> Maybe (LayoutTree a)
lookupLF :: forall a. 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

-- | Create a 'LayoutForest' with one element
singletonLF :: NodeId -> LayoutTree a -> LayoutForest a
singletonLF :: forall a. 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)

-- | Produce a 'LayoutForest' from a list. The order of the list is preserved.
fromListLF :: [(NodeId, LayoutTree a)] -> LayoutForest a
fromListLF :: forall a. [(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

-- | Extract the information at the root of a 'LayoutTree'
rootLT :: LayoutTree a -> a
rootLT :: forall a. LayoutTree a -> a
rootLT (LayoutTree a
a LayoutForest a
_) = a
a

-- | Extract the child nodes of a 'LayoutTree'
childrenLT :: LayoutTree a -> LayoutForest a
childrenLT :: forall a. LayoutTree a -> LayoutForest a
childrenLT (LayoutTree a
_ LayoutForest a
a) = LayoutForest a
a

-- | Produce a layout solution given a starting orientation, the overall screen
-- size, and a set of constraints.
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 :: forall a. [(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 b a. (b -> a -> b) -> b -> [a] -> b
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 :: forall a. Int -> [(a, Constraint)] -> [(a, Int)]
computeSizes Int
available [(a, Constraint)]
constraints =
      -- The minimum amount of space we need. Calculated by adding up all of
      -- the fixed size items and all the minimum sizes of stretchable items
      let minTotal :: Int
minTotal = [Int] -> Int
forall a. Num a => [a] -> a
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
      -- The leftover space is the area we can allow stretchable items to
      -- expand into
          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)
      -- The number of stretchable items that will try to share some of the
      -- leftover space
          numStretch :: Int
numStretch = [(a, Constraint)] -> Int
forall a. [a] -> 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
      -- Space to allocate to the stretchable items (this is the same for all
      -- items and there may still be additional leftover space that will have
      -- to be unevenly distributed)
          szStretch :: Int
szStretch = Ratio Int -> Int
forall b. Integral b => Ratio Int -> b
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
      -- Remainder of available space after even distribution. This extra space
      -- will be distributed to as many stretchable widgets as possible.
          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 :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
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

-- | Produce a 'Region' given a starting orientation and region, and the offset
-- and main-axis size of the chunk.
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 = _region_top r + offset
    , _region_height = sz
    }
  Orientation
Orientation_Row -> Region
r
    { _region_left = _region_left r + offset
    , _region_width = sz
    }

-- ** The layout monad

-- | A class of operations for creating screen layouts.
class Monad m => HasLayout t m | m -> t where
  -- | Starts a parent element in the current layout with the given size
  -- constraint, which lays out its children according to the provided
  -- orientation.
  axis :: Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
  -- | Creates a child element in the current layout with the given size
  -- constraint, returning the 'Region' that the child element is allocated.
  region :: Dynamic t Constraint -> m (Dynamic t Region)
  -- | Returns the orientation of the containing 'axis'.
  askOrientation :: m (Dynamic t Orientation)

-- | A monad transformer that collects layout constraints and provides a layout
-- solution that satisfies those constraints.
newtype Layout t m a = Layout
  { forall t (m :: * -> *) a.
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
    ( (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
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> Layout t m a -> Layout t m b
fmap :: forall a b. (a -> b) -> Layout t m a -> Layout t m b
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> Layout t m b -> Layout t m a
<$ :: forall a b. a -> Layout t m b -> Layout t m a
Functor
    , Functor (Layout t m)
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)
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
$cpure :: forall t (m :: * -> *) a. Monad m => a -> Layout t m a
pure :: forall a. a -> Layout t m a
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m (a -> b) -> Layout t m a -> Layout t m b
<*> :: forall a b. Layout t m (a -> b) -> Layout t m a -> Layout t m b
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
liftA2 :: forall a b c.
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
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 b
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
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 a
Applicative
    , HasDisplayRegion t
    , Applicative (Layout t m)
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)
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
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> (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
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
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 b
$creturn :: forall t (m :: * -> *) a. Monad m => a -> Layout t m a
return :: forall a. a -> Layout t m a
Monad
    , Monad (Layout t m)
Monad (Layout t m) =>
(forall a. (a -> Layout t m a) -> Layout t m a)
-> MonadFix (Layout t m)
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
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> Layout t m a) -> Layout t m a
mfix :: forall a. (a -> Layout t m a) -> Layout t m a
MonadFix
    , MonadHold t
    , Monad (Layout t m)
Monad (Layout t m) =>
(forall a. IO a -> Layout t m a) -> MonadIO (Layout t m)
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
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> Layout t m a
liftIO :: forall a. IO a -> Layout t m a
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
$cgetNextNodeId :: forall t (m :: * -> *). MonadNodeId m => Layout t m NodeId
getNextNodeId :: Layout t m NodeId
MonadNodeId
    , MonadReflexCreateTrigger t
    , MonadSample t
    , NotReady t
    , PerformEvent t
    , PostBuild t
    , TriggerEvent t
    )

instance MonadTrans (Layout t) where
  lift :: forall (m :: * -> *) a. Monad m => 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 (m :: * -> *) a.
Monad m =>
m a
-> DynamicWriterT t (LayoutForest (Constraint, 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 (m :: * -> *) a.
Monad m =>
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 (m :: * -> *) (n :: * -> *) b.
Monad m =>
(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
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> DynamicWriterT t (LayoutForest (Constraint, Orientation)) m b
-> DynamicWriterT t (LayoutForest (Constraint, Orientation)) 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
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m b
-> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) n b
hoist m a -> n a
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 :: forall a b.
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 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 a b. (a -> b) -> Event t a -> Event t 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 :: forall v v'.
(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 v v'.
(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 (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
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 (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
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

-- | Apply a transformation to the context of a child 'Layout' action and run
-- that action
hoistRunLayout
  :: (HasDisplayRegion t m, MonadFix m, Monad n)
  => (m a -> n b)
  -> Layout t m a
  -> Layout t n b
hoistRunLayout :: 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 -> 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 (m :: * -> *) a. Monad m => m a -> Layout t m a
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 a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
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 :: forall a.
(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 a. (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 :: forall a.
(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 a. (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 :: forall a.
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 (m :: * -> *) a.
Monad m =>
m a
-> DynamicWriterT t (LayoutForest (Constraint, 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, 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 a.
(Dynamic t (LayoutTree (Region, Orientation))
 -> Dynamic t (LayoutTree (Region, Orientation)))
-> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a
-> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a
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 a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
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 a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
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 a.
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 (m :: * -> *) a. Monad m => m a -> Layout t m a
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 a. a -> Layout t m a
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 a b. (a -> b) -> Dynamic t a -> Dynamic t b
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 (m :: * -> *) a. Monad m => m a -> Layout t m a
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 (m :: * -> *) a. Monad m => m a -> Layout t m a
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 (m :: * -> *) a. Monad m => m a -> Layout t m a
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 (m :: * -> *) a. Monad m => m a -> Layout t m a
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 :: forall a. 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 (m :: * -> *) a.
Monad m =>
m a
-> DynamicWriterT t (LayoutForest (Constraint, 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, 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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m a
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 a. m a -> m (a, 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 a.
a
-> DynamicWriterT
     t
     (LayoutForest (Constraint, Orientation))
     (ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Dynamic t FocusSet
sf)

-- | Runs a 'Layout' action, using the given orientation and region to
-- calculate layout solutions.
runLayout
  :: (MonadFix m, Reflex t)
  => Dynamic t Orientation
  -> Dynamic t Region
  -> Layout t m a
  -> m a
runLayout :: forall (m :: * -> *) t a.
(MonadFix m, Reflex t) =>
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 a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
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 a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t (LayoutForest (Constraint, Orientation))
w
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Initialize and run the layout monad, using all of the available screen space.
initLayout :: (HasDisplayRegion t m, MonadFix m) => Layout t m a -> m a
initLayout :: forall t (m :: * -> *) a.
(HasDisplayRegion t m, MonadFix m) =>
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 a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
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 a. a -> Dynamic t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Orientation_Column) Dynamic t Region
r Layout t m a
f

-- * The tile "window manager"
--
-- $tiling
-- Generally HasLayout and HasFocus are used together to build a user
-- interface. These functions check the available screen size and initialize
-- the layout monad with that information, and also initialize the focus monad.

-- | Initialize a 'Layout' and 'Focus'  management context, returning the produced 'FocusSet'.
initManager
  :: (HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m)
  => Layout t (Focus t m) a
  -> m (a, Dynamic t FocusSet)
initManager :: 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 =
  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

-- | Initialize a 'Layout' and 'Focus'  management context.
initManager_
  :: (HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m)
  => Layout t (Focus t m) a
  -> m a
initManager_ :: forall t (m :: * -> *) a.
(HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m) =>
Layout t (Focus t m) a -> m a
initManager_ = ((a, Dynamic t FocusSet) -> a) -> m (a, Dynamic t FocusSet) -> m a
forall a b. (a -> b) -> m a -> m b
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

-- ** Layout tiles

-- *** Focusable

-- | A widget that is focusable and occupies a layout region based on the
-- provided constraint. Returns the 'FocusId' allowing for manual focus
-- management.
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' :: 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 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 a. a -> m a
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 a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
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 a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
click
  (FocusId, a) -> m (FocusId, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FocusId
fid, a
result)

-- | A widget that is focusable and occupies a layout region based on the
-- provided constraint.
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 :: 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 a
tile Dynamic t Constraint
c = ((FocusId, a) -> a) -> m (FocusId, a) -> m a
forall a b. (a -> b) -> m a -> m b
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

-- *** Unfocusable

-- | A widget that is not focusable and occupies a layout region based on the
-- provided constraint.
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 :: forall {k} (m :: * -> *) (t :: k) a.
(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
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 a. a -> Dynamic t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) m a
w