{-|
Module: Reflex.Vty.Widget.Layout
Description: Monad transformer and tools for arranging widgets and building screen layouts
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE UndecidableInstances #-}

module Reflex.Vty.Widget.Layout
  (  Orientation(..)
  , Constraint(..)
  , Layout
  , runLayout
  , TileConfig(..)
  , tile
  , fixed
  , stretch
  , col
  , row
  , tabNavigation
  , askOrientation
  ) where

import Control.Monad.NodeId (NodeId, MonadNodeId(..))
import Control.Monad.Reader
import Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap
import Data.Default (Default(..))
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Monoid hiding (First(..))
import Data.Ratio ((%))
import Data.Semigroup (First(..))
import qualified Graphics.Vty as V

import Reflex
import Reflex.Host.Class (MonadReflexCreateTrigger)
import Reflex.Vty.Widget

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

data LayoutSegment = LayoutSegment
  { LayoutSegment -> Int
_layoutSegment_offset :: Int
  , LayoutSegment -> Int
_layoutSegment_size :: Int
  }

data LayoutCtx t = LayoutCtx
  { LayoutCtx t -> Dynamic t (Map NodeId LayoutSegment)
_layoutCtx_regions :: Dynamic t (Map NodeId LayoutSegment)
  , LayoutCtx t -> Demux t (Maybe NodeId)
_layoutCtx_focusDemux :: Demux t (Maybe NodeId)
  , LayoutCtx t -> Dynamic t Orientation
_layoutCtx_orientation :: Dynamic t Orientation
  }

-- | The Layout monad transformer keeps track of the configuration (e.g., 'Orientation') and
-- 'Constraint's of its child widgets, apportions vty real estate to each, and acts as a
-- switchboard for focus requests. See 'tile' and 'runLayout'.
newtype Layout t m a = Layout
  { Layout t m a
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     a
unLayout :: EventWriterT t (First NodeId)
      (DynamicWriterT t (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t)
          (VtyWidget t m))) a
  } deriving
    ( a -> Layout t m b -> Layout t m a
(a -> b) -> Layout t m a -> Layout t m b
(forall a b. (a -> b) -> Layout t m a -> Layout t m b)
-> (forall a b. a -> Layout t m b -> Layout t m a)
-> Functor (Layout t m)
forall a b. a -> Layout t m b -> Layout t m a
forall a b. (a -> b) -> Layout t m a -> Layout t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> Layout t m b -> Layout t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> Layout t m a -> Layout t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Layout t m b -> Layout t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> Layout t m b -> Layout t m a
fmap :: (a -> b) -> Layout t m a -> Layout t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> Layout t m a -> Layout t m b
Functor
    , Functor (Layout t m)
a -> Layout t m a
Functor (Layout t m) =>
(forall a. a -> Layout t m a)
-> (forall a b.
    Layout t m (a -> b) -> Layout t m a -> Layout t m b)
-> (forall a b c.
    (a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c)
-> (forall a b. Layout t m a -> Layout t m b -> Layout t m b)
-> (forall a b. Layout t m a -> Layout t m b -> Layout t m a)
-> Applicative (Layout t m)
Layout t m a -> Layout t m b -> Layout t m b
Layout t m a -> Layout t m b -> Layout t m a
Layout t m (a -> b) -> Layout t m a -> Layout t m b
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
forall a. a -> Layout t m a
forall a b. Layout t m a -> Layout t m b -> Layout t m a
forall a b. Layout t m a -> Layout t m b -> Layout t m b
forall a b. Layout t m (a -> b) -> Layout t m a -> Layout t m b
forall a b c.
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
forall t (m :: * -> *). Monad m => Functor (Layout t m)
forall t (m :: * -> *) a. Monad m => a -> Layout t m a
forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m a
forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m b
forall t (m :: * -> *) a b.
Monad m =>
Layout t m (a -> b) -> Layout t m a -> Layout t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Layout t m a -> Layout t m b -> Layout t m a
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m a
*> :: Layout t m a -> Layout t m b -> Layout t m b
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m b
liftA2 :: (a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Layout t m a -> Layout t m b -> Layout t m c
<*> :: Layout t m (a -> b) -> Layout t m a -> Layout t m b
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m (a -> b) -> Layout t m a -> Layout t m b
pure :: a -> Layout t m a
$cpure :: forall t (m :: * -> *) a. Monad m => a -> Layout t m a
$cp1Applicative :: forall t (m :: * -> *). Monad m => Functor (Layout t m)
Applicative
    , Applicative (Layout t m)
a -> Layout t m a
Applicative (Layout t m) =>
(forall a b. Layout t m a -> (a -> Layout t m b) -> Layout t m b)
-> (forall a b. Layout t m a -> Layout t m b -> Layout t m b)
-> (forall a. a -> Layout t m a)
-> Monad (Layout t m)
Layout t m a -> (a -> Layout t m b) -> Layout t m b
Layout t m a -> Layout t m b -> Layout t m b
forall a. a -> Layout t m a
forall a b. Layout t m a -> Layout t m b -> Layout t m b
forall a b. Layout t m a -> (a -> Layout t m b) -> Layout t m b
forall t (m :: * -> *). Monad m => Applicative (Layout t m)
forall t (m :: * -> *) a. Monad m => a -> Layout t m a
forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m b
forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> (a -> Layout t m b) -> Layout t m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Layout t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> Layout t m a
>> :: Layout t m a -> Layout t m b -> Layout t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> Layout t m b -> Layout t m b
>>= :: Layout t m a -> (a -> Layout t m b) -> Layout t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
Layout t m a -> (a -> Layout t m b) -> Layout t m b
$cp1Monad :: forall t (m :: * -> *). Monad m => Applicative (Layout t m)
Monad
    , MonadHold t
    , MonadSample t
    , Monad (Layout t m)
Monad (Layout t m) =>
(forall a. (a -> Layout t m a) -> Layout t m a)
-> MonadFix (Layout t m)
(a -> Layout t m a) -> Layout t m a
forall a. (a -> Layout t m a) -> Layout t m a
forall t (m :: * -> *). MonadFix m => Monad (Layout t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> Layout t m a) -> Layout t m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> Layout t m a) -> Layout t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> Layout t m a) -> Layout t m a
$cp1MonadFix :: forall t (m :: * -> *). MonadFix m => Monad (Layout t m)
MonadFix
    , TriggerEvent t
    , PerformEvent t
    , NotReady t
    , MonadReflexCreateTrigger t
    , HasDisplaySize t
    , Monad (Layout t m)
Layout t m NodeId
Monad (Layout t m) => Layout t m NodeId -> MonadNodeId (Layout t m)
forall t (m :: * -> *). MonadNodeId m => Monad (Layout t m)
forall t (m :: * -> *). MonadNodeId m => Layout t m NodeId
forall (m :: * -> *). Monad m => m NodeId -> MonadNodeId m
getNextNodeId :: Layout t m NodeId
$cgetNextNodeId :: forall t (m :: * -> *). MonadNodeId m => Layout t m NodeId
$cp1MonadNodeId :: forall t (m :: * -> *). MonadNodeId m => Monad (Layout t m)
MonadNodeId
    , PostBuild t
    )

instance MonadTrans (Layout t) where
  lift :: m a -> Layout t m a
lift x :: m a
x = EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   a
 -> Layout t m a)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     a
-> Layout t m a
forall a b. (a -> b) -> a -> b
$ DynamicWriterT
  t
  (Endo [(NodeId, (Bool, Constraint))])
  (ReaderT (LayoutCtx t) (VtyWidget t m))
  a
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DynamicWriterT
   t
   (Endo [(NodeId, (Bool, Constraint))])
   (ReaderT (LayoutCtx t) (VtyWidget t m))
   a
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      a)
-> DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m))
     a
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     a
forall a b. (a -> b) -> a -> b
$ ReaderT (LayoutCtx t) (VtyWidget t m) a
-> DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m))
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (LayoutCtx t) (VtyWidget t m) a
 -> DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m))
      a)
-> ReaderT (LayoutCtx t) (VtyWidget t m) a
-> DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m))
     a
forall a b. (a -> b) -> a -> b
$ VtyWidget t m a -> ReaderT (LayoutCtx t) (VtyWidget t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (VtyWidget t m a -> ReaderT (LayoutCtx t) (VtyWidget t m) a)
-> VtyWidget t m a -> ReaderT (LayoutCtx t) (VtyWidget t m) a
forall a b. (a -> b) -> a -> b
$ m a -> VtyWidget t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
x

instance (Adjustable t m, MonadFix m, MonadHold t m) => Adjustable t (Layout t m) where
  runWithReplace :: Layout t m a -> Event t (Layout t m b) -> Layout t m (a, Event t b)
runWithReplace (Layout a :: EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
a) e :: Event t (Layout t m b)
e = EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  (a, Event t b)
-> Layout t m (a, Event t b)
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   (a, Event t b)
 -> Layout t m (a, Event t b))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (a, Event t b)
-> Layout t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Event
     t
     (EventWriterT
        t
        (First NodeId)
        (DynamicWriterT
           t
           (Endo [(NodeId, (Bool, Constraint))])
           (ReaderT (LayoutCtx t) (VtyWidget t m)))
        b)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t 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 EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
a (Event
   t
   (EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      b)
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      (a, Event t b))
-> Event
     t
     (EventWriterT
        t
        (First NodeId)
        (DynamicWriterT
           t
           (Endo [(NodeId, (Bool, Constraint))])
           (ReaderT (LayoutCtx t) (VtyWidget t m)))
        b)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (a, Event t b)
forall a b. (a -> b) -> a -> b
$ (Layout t m b
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      b)
-> Event t (Layout t m b)
-> Event
     t
     (EventWriterT
        t
        (First NodeId)
        (DynamicWriterT
           t
           (Endo [(NodeId, (Bool, Constraint))])
           (ReaderT (LayoutCtx t) (VtyWidget t m)))
        b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Layout t m b
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     b
forall t (m :: * -> *) a.
Layout t m a
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     a
unLayout Event t (Layout t m b)
e
  traverseIntMapWithKeyWithAdjust :: (Int -> v -> Layout t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> Layout t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust f :: Int -> v -> Layout t m v'
f m :: IntMap v
m e :: Event t (PatchIntMap v)
e = EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  (IntMap v', Event t (PatchIntMap v'))
-> Layout t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   (IntMap v', Event t (PatchIntMap v'))
 -> Layout t m (IntMap v', Event t (PatchIntMap v')))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t 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
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      v')
-> IntMap v
-> Event t (PatchIntMap v)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t 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 (\k :: Int
k v :: v
v -> Layout t m v'
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     v'
forall t (m :: * -> *) a.
Layout t m a
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     a
unLayout (Layout t m v'
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      v')
-> Layout t m v'
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     v'
forall a b. (a -> b) -> a -> b
$ Int -> v -> Layout t m v'
f Int
k v
v) IntMap v
m Event t (PatchIntMap v)
e
  traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> Layout t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> Layout t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust f :: forall a. k a -> v a -> Layout t m (v' a)
f m :: DMap k v
m e :: Event t (PatchDMap k v)
e = EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  (DMap k v', Event t (PatchDMap k v'))
-> Layout t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   (DMap k v', Event t (PatchDMap k v'))
 -> Layout t m (DMap k v', Event t (PatchDMap k v')))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t 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
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k :: k a
k v :: v a
v -> Layout t m (v' a)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (v' a)
forall t (m :: * -> *) a.
Layout t m a
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     a
unLayout (Layout t m (v' a)
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      (v' a))
-> Layout t m (v' a)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> Layout t m (v' a)
forall a. k a -> v a -> Layout t m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMap k v)
e
  traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> Layout t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> Layout t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove f :: forall a. k a -> v a -> Layout t m (v' a)
f m :: DMap k v
m e :: Event t (PatchDMapWithMove k v)
e = EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  (DMap k v', Event t (PatchDMapWithMove k v'))
-> Layout t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   (DMap k v', Event t (PatchDMapWithMove k v'))
 -> Layout t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t 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
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k :: k a
k v :: v a
v -> Layout t m (v' a)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (v' a)
forall t (m :: * -> *) a.
Layout t m a
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     a
unLayout (Layout t m (v' a)
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      (v' a))
-> Layout t m (v' a)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t 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

-- | Run a 'Layout' action
runLayout
  :: (MonadFix m, MonadHold t m, PostBuild t m, Monad m, MonadNodeId m)
  => Dynamic t Orientation -- ^ The main-axis 'Orientation' of this 'Layout'
  -> Int -- ^ The positional index of the initially focused tile
  -> Event t Int -- ^ An event that shifts focus by a given number of tiles
  -> Layout t m a -- ^ The 'Layout' widget
  -> VtyWidget t m a
runLayout :: Dynamic t Orientation
-> Int -> Event t Int -> Layout t m a -> VtyWidget t m a
runLayout ddir :: Dynamic t Orientation
ddir focus0 :: Int
focus0 focusShift :: Event t Int
focusShift (Layout child :: EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
child) = do
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  Dynamic t Int
dh <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight
  let main :: Dynamic t Int
main = Dynamic t Orientation
-> Dynamic t Int
-> Dynamic t Int
-> (Orientation -> Int -> Int -> Int)
-> Dynamic t Int
forall (f :: * -> *) a b c d.
Applicative f =>
f a -> f b -> f c -> (a -> b -> c -> d) -> f d
ffor3 Dynamic t Orientation
ddir Dynamic t Int
dw Dynamic t Int
dh ((Orientation -> Int -> Int -> Int) -> Dynamic t Int)
-> (Orientation -> Int -> Int -> Int) -> Dynamic t Int
forall a b. (a -> b) -> a -> b
$ \d :: Orientation
d w :: Int
w h :: Int
h -> case Orientation
d of
        Orientation_Column -> Int
h
        Orientation_Row -> Int
w
  Event t ()
pb <- VtyWidget t m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  rec ((a :: a
a, focusReq :: Event t (First NodeId)
focusReq), queriesEndo :: Dynamic t (Endo [(NodeId, (Bool, Constraint))])
queriesEndo) <- ReaderT
  (LayoutCtx t)
  (VtyWidget t m)
  ((a, Event t (First NodeId)),
   Dynamic t (Endo [(NodeId, (Bool, Constraint))]))
-> LayoutCtx t
-> VtyWidget
     t
     m
     ((a, Event t (First NodeId)),
      Dynamic t (Endo [(NodeId, (Bool, Constraint))]))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DynamicWriterT
  t
  (Endo [(NodeId, (Bool, Constraint))])
  (ReaderT (LayoutCtx t) (VtyWidget t m))
  (a, Event t (First NodeId))
-> ReaderT
     (LayoutCtx t)
     (VtyWidget t m)
     ((a, Event t (First NodeId)),
      Dynamic t (Endo [(NodeId, (Bool, Constraint))]))
forall (m :: * -> *) t w a.
(MonadFix m, Reflex t, Monoid w) =>
DynamicWriterT t w m a -> m (a, Dynamic t w)
runDynamicWriterT (DynamicWriterT
   t
   (Endo [(NodeId, (Bool, Constraint))])
   (ReaderT (LayoutCtx t) (VtyWidget t m))
   (a, Event t (First NodeId))
 -> ReaderT
      (LayoutCtx t)
      (VtyWidget t m)
      ((a, Event t (First NodeId)),
       Dynamic t (Endo [(NodeId, (Bool, Constraint))])))
-> DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m))
     (a, Event t (First NodeId))
-> ReaderT
     (LayoutCtx t)
     (VtyWidget t m)
     ((a, Event t (First NodeId)),
      Dynamic t (Endo [(NodeId, (Bool, Constraint))]))
forall a b. (a -> b) -> a -> b
$ EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m))
     (a, Event t (First NodeId))
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 NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
child) (LayoutCtx t
 -> VtyWidget
      t
      m
      ((a, Event t (First NodeId)),
       Dynamic t (Endo [(NodeId, (Bool, Constraint))])))
-> LayoutCtx t
-> VtyWidget
     t
     m
     ((a, Event t (First NodeId)),
      Dynamic t (Endo [(NodeId, (Bool, Constraint))]))
forall a b. (a -> b) -> a -> b
$ Dynamic t (Map NodeId LayoutSegment)
-> Demux t (Maybe NodeId) -> Dynamic t Orientation -> LayoutCtx t
forall t.
Dynamic t (Map NodeId LayoutSegment)
-> Demux t (Maybe NodeId) -> Dynamic t Orientation -> LayoutCtx t
LayoutCtx Dynamic t (Map NodeId LayoutSegment)
solutionMap Demux t (Maybe NodeId)
focusDemux Dynamic t Orientation
ddir
      let queries :: Dynamic t [(NodeId, (Bool, Constraint))]
queries = (Endo [(NodeId, (Bool, Constraint))]
 -> [(NodeId, (Bool, Constraint))]
 -> [(NodeId, (Bool, Constraint))])
-> [(NodeId, (Bool, Constraint))]
-> Endo [(NodeId, (Bool, Constraint))]
-> [(NodeId, (Bool, Constraint))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo [(NodeId, (Bool, Constraint))]
-> [(NodeId, (Bool, Constraint))] -> [(NodeId, (Bool, Constraint))]
forall a. Endo a -> a -> a
appEndo [] (Endo [(NodeId, (Bool, Constraint))]
 -> [(NodeId, (Bool, Constraint))])
-> Dynamic t (Endo [(NodeId, (Bool, Constraint))])
-> Dynamic t [(NodeId, (Bool, Constraint))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Endo [(NodeId, (Bool, Constraint))])
queriesEndo
          solution :: Dynamic t (Map NodeId (Int, Int))
solution = Dynamic t Int
-> Dynamic t [(NodeId, (Bool, Constraint))]
-> (Int -> [(NodeId, (Bool, Constraint))] -> Map NodeId (Int, Int))
-> Dynamic t (Map NodeId (Int, Int))
forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
main Dynamic t [(NodeId, (Bool, Constraint))]
queries ((Int -> [(NodeId, (Bool, Constraint))] -> Map NodeId (Int, Int))
 -> Dynamic t (Map NodeId (Int, Int)))
-> (Int -> [(NodeId, (Bool, Constraint))] -> Map NodeId (Int, Int))
-> Dynamic t (Map NodeId (Int, Int))
forall a b. (a -> b) -> a -> b
$ \sz :: Int
sz qs :: [(NodeId, (Bool, Constraint))]
qs -> [(NodeId, (Int, Int))] -> Map NodeId (Int, Int)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            ([(NodeId, (Int, Int))] -> Map NodeId (Int, Int))
-> ([(NodeId, (Bool, Constraint))] -> [(NodeId, (Int, Int))])
-> [(NodeId, (Bool, Constraint))]
-> Map NodeId (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Integer (NodeId, (Int, Int)) -> [(NodeId, (Int, Int))]
forall k a. Map k a -> [a]
Map.elems
            (Map Integer (NodeId, (Int, Int)) -> [(NodeId, (Int, Int))])
-> ([(NodeId, (Bool, Constraint))]
    -> Map Integer (NodeId, (Int, Int)))
-> [(NodeId, (Bool, Constraint))]
-> [(NodeId, (Int, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Integer (NodeId, Int) -> Map Integer (NodeId, (Int, Int))
forall k a. Ord k => Map k (a, Int) -> Map k (a, (Int, Int))
computeEdges
            (Map Integer (NodeId, Int) -> Map Integer (NodeId, (Int, Int)))
-> ([(NodeId, (Bool, Constraint))] -> Map Integer (NodeId, Int))
-> [(NodeId, (Bool, Constraint))]
-> Map Integer (NodeId, (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Map Integer (NodeId, Constraint) -> Map Integer (NodeId, Int)
forall k a. Ord k => Int -> Map k (a, Constraint) -> Map k (a, Int)
computeSizes Int
sz
            (Map Integer (NodeId, Constraint) -> Map Integer (NodeId, Int))
-> ([(NodeId, (Bool, Constraint))]
    -> Map Integer (NodeId, Constraint))
-> [(NodeId, (Bool, Constraint))]
-> Map Integer (NodeId, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NodeId, (Bool, Constraint)) -> (NodeId, Constraint))
-> Map Integer (NodeId, (Bool, Constraint))
-> Map Integer (NodeId, Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Bool, Constraint) -> Constraint)
-> (NodeId, (Bool, Constraint)) -> (NodeId, Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Constraint) -> Constraint
forall a b. (a, b) -> b
snd)
            (Map Integer (NodeId, (Bool, Constraint))
 -> Map Integer (NodeId, Constraint))
-> ([(NodeId, (Bool, Constraint))]
    -> Map Integer (NodeId, (Bool, Constraint)))
-> [(NodeId, (Bool, Constraint))]
-> Map Integer (NodeId, Constraint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Integer, (NodeId, (Bool, Constraint)))]
-> Map Integer (NodeId, (Bool, Constraint))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            ([(Integer, (NodeId, (Bool, Constraint)))]
 -> Map Integer (NodeId, (Bool, Constraint)))
-> ([(NodeId, (Bool, Constraint))]
    -> [(Integer, (NodeId, (Bool, Constraint)))])
-> [(NodeId, (Bool, Constraint))]
-> Map Integer (NodeId, (Bool, Constraint))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer]
-> [(NodeId, (Bool, Constraint))]
-> [(Integer, (NodeId, (Bool, Constraint)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [0::Integer ..]
            ([(NodeId, (Bool, Constraint))] -> Map NodeId (Int, Int))
-> [(NodeId, (Bool, Constraint))] -> Map NodeId (Int, Int)
forall a b. (a -> b) -> a -> b
$ [(NodeId, (Bool, Constraint))]
qs
          solutionMap :: Dynamic t (Map NodeId LayoutSegment)
solutionMap = Dynamic t (Map NodeId (Int, Int))
-> (Map NodeId (Int, Int) -> Map NodeId LayoutSegment)
-> Dynamic t (Map NodeId LayoutSegment)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Map NodeId (Int, Int))
solution ((Map NodeId (Int, Int) -> Map NodeId LayoutSegment)
 -> Dynamic t (Map NodeId LayoutSegment))
-> (Map NodeId (Int, Int) -> Map NodeId LayoutSegment)
-> Dynamic t (Map NodeId LayoutSegment)
forall a b. (a -> b) -> a -> b
$ \ss :: Map NodeId (Int, Int)
ss -> Map NodeId (Int, Int)
-> ((Int, Int) -> LayoutSegment) -> Map NodeId LayoutSegment
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Map NodeId (Int, Int)
ss (((Int, Int) -> LayoutSegment) -> Map NodeId LayoutSegment)
-> ((Int, Int) -> LayoutSegment) -> Map NodeId LayoutSegment
forall a b. (a -> b) -> a -> b
$ \(offset :: Int
offset, sz :: Int
sz) -> LayoutSegment :: Int -> Int -> LayoutSegment
LayoutSegment
            { _layoutSegment_offset :: Int
_layoutSegment_offset = Int
offset
            , _layoutSegment_size :: Int
_layoutSegment_size = Int
sz
            }
          focusable :: Dynamic t (Bimap Int NodeId)
focusable = ([NodeId] -> Bimap Int NodeId)
-> Dynamic t [NodeId] -> Dynamic t (Bimap Int NodeId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Int, NodeId)] -> Bimap Int NodeId
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
Bimap.fromList ([(Int, NodeId)] -> Bimap Int NodeId)
-> ([NodeId] -> [(Int, NodeId)]) -> [NodeId] -> Bimap Int NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [NodeId] -> [(Int, NodeId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..]) (Dynamic t [NodeId] -> Dynamic t (Bimap Int NodeId))
-> Dynamic t [NodeId] -> Dynamic t (Bimap Int NodeId)
forall a b. (a -> b) -> a -> b
$
            Dynamic t [(NodeId, (Bool, Constraint))]
-> ([(NodeId, (Bool, Constraint))] -> [NodeId])
-> Dynamic t [NodeId]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t [(NodeId, (Bool, Constraint))]
queries (([(NodeId, (Bool, Constraint))] -> [NodeId])
 -> Dynamic t [NodeId])
-> ([(NodeId, (Bool, Constraint))] -> [NodeId])
-> Dynamic t [NodeId]
forall a b. (a -> b) -> a -> b
$ \qs :: [(NodeId, (Bool, Constraint))]
qs -> [(NodeId, (Bool, Constraint))]
-> ((NodeId, (Bool, Constraint)) -> Maybe NodeId) -> [NodeId]
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe [(NodeId, (Bool, Constraint))]
qs (((NodeId, (Bool, Constraint)) -> Maybe NodeId) -> [NodeId])
-> ((NodeId, (Bool, Constraint)) -> Maybe NodeId) -> [NodeId]
forall a b. (a -> b) -> a -> b
$ \(nodeId :: NodeId
nodeId, (f :: Bool
f, _)) ->
              if Bool
f then NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just NodeId
nodeId else Maybe NodeId
forall a. Maybe a
Nothing
          adjustFocus
            :: (Bimap Int NodeId, (Int, Maybe NodeId))
            -> Either Int NodeId
            -> (Int, Maybe NodeId)
          adjustFocus :: (Bimap Int NodeId, (Int, Maybe NodeId))
-> Either Int NodeId -> (Int, Maybe NodeId)
adjustFocus (fm :: Bimap Int NodeId
fm, (cur :: Int
cur, _)) (Left shift :: Int
shift) =
            let ix :: Int
ix = (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shift) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Bimap Int NodeId -> Int
forall a b. Bimap a b -> Int
Bimap.size Bimap Int NodeId
fm)
            in (Int
ix, Int -> Bimap Int NodeId -> Maybe NodeId
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
Bimap.lookup Int
ix Bimap Int NodeId
fm)
          adjustFocus (fm :: Bimap Int NodeId
fm, (cur :: Int
cur, _)) (Right goto :: NodeId
goto) =
            let ix :: Int
ix = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
cur (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ NodeId -> Bimap Int NodeId -> Maybe Int
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
Bimap.lookupR NodeId
goto Bimap Int NodeId
fm
            in (Int
ix, NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just NodeId
goto)
          focusChange :: Event t (Int, Maybe NodeId)
focusChange = ((Bimap Int NodeId, (Int, Maybe NodeId))
 -> Either Int NodeId -> (Int, Maybe NodeId))
-> Behavior t (Bimap Int NodeId, (Int, Maybe NodeId))
-> Event t (Either Int NodeId)
-> Event t (Int, Maybe NodeId)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith
            (Bimap Int NodeId, (Int, Maybe NodeId))
-> Either Int NodeId -> (Int, Maybe NodeId)
adjustFocus
            (Dynamic t (Bimap Int NodeId, (Int, Maybe NodeId))
-> Behavior t (Bimap Int NodeId, (Int, Maybe NodeId))
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current (Dynamic t (Bimap Int NodeId, (Int, Maybe NodeId))
 -> Behavior t (Bimap Int NodeId, (Int, Maybe NodeId)))
-> Dynamic t (Bimap Int NodeId, (Int, Maybe NodeId))
-> Behavior t (Bimap Int NodeId, (Int, Maybe NodeId))
forall a b. (a -> b) -> a -> b
$ (,) (Bimap Int NodeId
 -> (Int, Maybe NodeId) -> (Bimap Int NodeId, (Int, Maybe NodeId)))
-> Dynamic t (Bimap Int NodeId)
-> Dynamic
     t ((Int, Maybe NodeId) -> (Bimap Int NodeId, (Int, Maybe NodeId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Bimap Int NodeId)
focusable Dynamic
  t ((Int, Maybe NodeId) -> (Bimap Int NodeId, (Int, Maybe NodeId)))
-> Dynamic t (Int, Maybe NodeId)
-> Dynamic t (Bimap Int NodeId, (Int, Maybe NodeId))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t (Int, Maybe NodeId)
focussed)
            (Event t (Either Int NodeId) -> Event t (Int, Maybe NodeId))
-> Event t (Either Int NodeId) -> Event t (Int, Maybe NodeId)
forall a b. (a -> b) -> a -> b
$ [Event t (Either Int NodeId)] -> Event t (Either Int NodeId)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Int -> Either Int NodeId
forall a b. a -> Either a b
Left (Int -> Either Int NodeId)
-> Event t Int -> Event t (Either Int NodeId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Int
focusShift, Int -> Either Int NodeId
forall a b. a -> Either a b
Left 0 Either Int NodeId -> Event t () -> Event t (Either Int NodeId)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ()
pb, NodeId -> Either Int NodeId
forall a b. b -> Either a b
Right (NodeId -> Either Int NodeId)
-> (First NodeId -> NodeId) -> First NodeId -> Either Int NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First NodeId -> NodeId
forall a. First a -> a
getFirst (First NodeId -> Either Int NodeId)
-> Event t (First NodeId) -> Event t (Either Int NodeId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (First NodeId)
focusReq]
      -- A pair (Int, Maybe NodeId) which represents the index
      -- that we're trying to focus, and the node that actually gets
      -- focused (at that index) if it exists
      Dynamic t (Int, Maybe NodeId)
focussed <- (Int, Maybe NodeId)
-> Event t (Int, Maybe NodeId)
-> VtyWidget t m (Dynamic t (Int, Maybe NodeId))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (Int
focus0, Maybe NodeId
forall a. Maybe a
Nothing) Event t (Int, Maybe NodeId)
focusChange
      let focusDemux :: Demux t (Maybe NodeId)
focusDemux = Dynamic t (Maybe NodeId) -> Demux t (Maybe NodeId)
forall k1 (t :: k1) k2.
(Reflex t, Ord k2) =>
Dynamic t k2 -> Demux t k2
demux (Dynamic t (Maybe NodeId) -> Demux t (Maybe NodeId))
-> Dynamic t (Maybe NodeId) -> Demux t (Maybe NodeId)
forall a b. (a -> b) -> a -> b
$ (Int, Maybe NodeId) -> Maybe NodeId
forall a b. (a, b) -> b
snd ((Int, Maybe NodeId) -> Maybe NodeId)
-> Dynamic t (Int, Maybe NodeId) -> Dynamic t (Maybe NodeId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Int, Maybe NodeId)
focussed
  a -> VtyWidget t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Tiles are the basic building blocks of 'Layout' widgets. Each tile has a constraint
-- on its size and ability to grow and on whether it can be focused. It also allows its child
-- widget to request focus.
tile
  :: (Reflex t, Monad m, MonadNodeId m)
  => TileConfig t -- ^ The tile's configuration
  -> VtyWidget t m (Event t x, a) -- ^ A child widget. The 'Event' that it returns is used to request that it be focused.
  -> Layout t m a
tile :: TileConfig t -> VtyWidget t m (Event t x, a) -> Layout t m a
tile (TileConfig con :: Dynamic t Constraint
con focusable :: Dynamic t Bool
focusable) child :: VtyWidget t m (Event t x, a)
child = do
  NodeId
nodeId <- Layout t m NodeId
forall (m :: * -> *). MonadNodeId m => m NodeId
getNextNodeId
  EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  ()
-> Layout t m ()
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   ()
 -> Layout t m ())
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     ()
-> Layout t m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t (Endo [(NodeId, (Bool, Constraint))])
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     ()
forall t w (m :: * -> *).
DynamicWriter t w m =>
Dynamic t w -> m ()
tellDyn (Dynamic t (Endo [(NodeId, (Bool, Constraint))])
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      ())
-> Dynamic t (Endo [(NodeId, (Bool, Constraint))])
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     ()
forall a b. (a -> b) -> a -> b
$ Dynamic t Constraint
-> Dynamic t Bool
-> (Constraint -> Bool -> Endo [(NodeId, (Bool, Constraint))])
-> Dynamic t (Endo [(NodeId, (Bool, Constraint))])
forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Constraint
con Dynamic t Bool
focusable ((Constraint -> Bool -> Endo [(NodeId, (Bool, Constraint))])
 -> Dynamic t (Endo [(NodeId, (Bool, Constraint))]))
-> (Constraint -> Bool -> Endo [(NodeId, (Bool, Constraint))])
-> Dynamic t (Endo [(NodeId, (Bool, Constraint))])
forall a b. (a -> b) -> a -> b
$ \c :: Constraint
c f :: Bool
f -> ([(NodeId, (Bool, Constraint))] -> [(NodeId, (Bool, Constraint))])
-> Endo [(NodeId, (Bool, Constraint))]
forall a. (a -> a) -> Endo a
Endo ((NodeId
nodeId, (Bool
f, Constraint
c))(NodeId, (Bool, Constraint))
-> [(NodeId, (Bool, Constraint))] -> [(NodeId, (Bool, Constraint))]
forall a. a -> [a] -> [a]
:)
  Dynamic t LayoutSegment
seg <- EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  (Dynamic t LayoutSegment)
-> Layout t m (Dynamic t LayoutSegment)
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   (Dynamic t LayoutSegment)
 -> Layout t m (Dynamic t LayoutSegment))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Dynamic t LayoutSegment)
-> Layout t m (Dynamic t LayoutSegment)
forall a b. (a -> b) -> a -> b
$ (LayoutCtx t -> Dynamic t LayoutSegment)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Dynamic t LayoutSegment)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((LayoutCtx t -> Dynamic t LayoutSegment)
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      (Dynamic t LayoutSegment))
-> (LayoutCtx t -> Dynamic t LayoutSegment)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Dynamic t LayoutSegment)
forall a b. (a -> b) -> a -> b
$
    (Map NodeId LayoutSegment -> LayoutSegment)
-> Dynamic t (Map NodeId LayoutSegment) -> Dynamic t LayoutSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LayoutSegment
-> NodeId -> Map NodeId LayoutSegment -> LayoutSegment
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Int -> Int -> LayoutSegment
LayoutSegment 0 0) NodeId
nodeId) (Dynamic t (Map NodeId LayoutSegment) -> Dynamic t LayoutSegment)
-> (LayoutCtx t -> Dynamic t (Map NodeId LayoutSegment))
-> LayoutCtx t
-> Dynamic t LayoutSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutCtx t -> Dynamic t (Map NodeId LayoutSegment)
forall t. LayoutCtx t -> Dynamic t (Map NodeId LayoutSegment)
_layoutCtx_regions
  Dynamic t Int
dw <- Layout t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  Dynamic t Int
dh <- Layout t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight
  Dynamic t Orientation
o <- Layout t m (Dynamic t Orientation)
forall (m :: * -> *) t.
Monad m =>
Layout t m (Dynamic t Orientation)
askOrientation
  let cross :: Dynamic t Int
cross = Dynamic t (Dynamic t Int) -> Dynamic t Int
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Dynamic t (Dynamic t Int) -> Dynamic t Int)
-> Dynamic t (Dynamic t Int) -> Dynamic t Int
forall a b. (a -> b) -> a -> b
$ Dynamic t Orientation
-> (Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Orientation
o ((Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int))
-> (Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ \case
        Orientation_Column -> Dynamic t Int
dw
        Orientation_Row -> Dynamic t Int
dh
  let reg :: DynRegion t
reg = DynRegion :: forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion
        { _dynRegion_top :: Dynamic t Int
_dynRegion_top = Dynamic t LayoutSegment
-> Dynamic t Orientation
-> (LayoutSegment -> Orientation -> Int)
-> Dynamic t Int
forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t LayoutSegment
seg Dynamic t Orientation
o ((LayoutSegment -> Orientation -> Int) -> Dynamic t Int)
-> (LayoutSegment -> Orientation -> Int) -> Dynamic t Int
forall a b. (a -> b) -> a -> b
$ \s :: LayoutSegment
s -> \case
            Orientation_Column -> LayoutSegment -> Int
_layoutSegment_offset LayoutSegment
s
            Orientation_Row -> 0
        , _dynRegion_left :: Dynamic t Int
_dynRegion_left = Dynamic t LayoutSegment
-> Dynamic t Orientation
-> (LayoutSegment -> Orientation -> Int)
-> Dynamic t Int
forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t LayoutSegment
seg Dynamic t Orientation
o ((LayoutSegment -> Orientation -> Int) -> Dynamic t Int)
-> (LayoutSegment -> Orientation -> Int) -> Dynamic t Int
forall a b. (a -> b) -> a -> b
$ \s :: LayoutSegment
s -> \case
            Orientation_Column -> 0
            Orientation_Row -> LayoutSegment -> Int
_layoutSegment_offset LayoutSegment
s
        , _dynRegion_width :: Dynamic t Int
_dynRegion_width = Dynamic t LayoutSegment
-> Dynamic t Int
-> Dynamic t Orientation
-> (LayoutSegment -> Int -> Orientation -> Int)
-> Dynamic t Int
forall (f :: * -> *) a b c d.
Applicative f =>
f a -> f b -> f c -> (a -> b -> c -> d) -> f d
ffor3 Dynamic t LayoutSegment
seg Dynamic t Int
cross Dynamic t Orientation
o ((LayoutSegment -> Int -> Orientation -> Int) -> Dynamic t Int)
-> (LayoutSegment -> Int -> Orientation -> Int) -> Dynamic t Int
forall a b. (a -> b) -> a -> b
$ \s :: LayoutSegment
s c :: Int
c -> \case
            Orientation_Column -> Int
c
            Orientation_Row -> LayoutSegment -> Int
_layoutSegment_size LayoutSegment
s
        , _dynRegion_height :: Dynamic t Int
_dynRegion_height = Dynamic t LayoutSegment
-> Dynamic t Int
-> Dynamic t Orientation
-> (LayoutSegment -> Int -> Orientation -> Int)
-> Dynamic t Int
forall (f :: * -> *) a b c d.
Applicative f =>
f a -> f b -> f c -> (a -> b -> c -> d) -> f d
ffor3 Dynamic t LayoutSegment
seg Dynamic t Int
cross Dynamic t Orientation
o ((LayoutSegment -> Int -> Orientation -> Int) -> Dynamic t Int)
-> (LayoutSegment -> Int -> Orientation -> Int) -> Dynamic t Int
forall a b. (a -> b) -> a -> b
$ \s :: LayoutSegment
s c :: Int
c -> \case
            Orientation_Column -> LayoutSegment -> Int
_layoutSegment_size LayoutSegment
s
            Orientation_Row -> Int
c
        }
  Demux t (Maybe NodeId)
focussed <- EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  (Demux t (Maybe NodeId))
-> Layout t m (Demux t (Maybe NodeId))
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   (Demux t (Maybe NodeId))
 -> Layout t m (Demux t (Maybe NodeId)))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Demux t (Maybe NodeId))
-> Layout t m (Demux t (Maybe NodeId))
forall a b. (a -> b) -> a -> b
$ (LayoutCtx t -> Demux t (Maybe NodeId))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Demux t (Maybe NodeId))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LayoutCtx t -> Demux t (Maybe NodeId)
forall t. LayoutCtx t -> Demux t (Maybe NodeId)
_layoutCtx_focusDemux
  (focusReq :: Event t x
focusReq, a :: a
a) <- EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  (Event t x, a)
-> Layout t m (Event t x, a)
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   (Event t x, a)
 -> Layout t m (Event t x, a))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Event t x, a)
-> Layout t m (Event t x, a)
forall a b. (a -> b) -> a -> b
$ DynamicWriterT
  t
  (Endo [(NodeId, (Bool, Constraint))])
  (ReaderT (LayoutCtx t) (VtyWidget t m))
  (Event t x, a)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Event t x, a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DynamicWriterT
   t
   (Endo [(NodeId, (Bool, Constraint))])
   (ReaderT (LayoutCtx t) (VtyWidget t m))
   (Event t x, a)
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      (Event t x, a))
-> DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m))
     (Event t x, a)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Event t x, a)
forall a b. (a -> b) -> a -> b
$ ReaderT (LayoutCtx t) (VtyWidget t m) (Event t x, a)
-> DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m))
     (Event t x, a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (LayoutCtx t) (VtyWidget t m) (Event t x, a)
 -> DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m))
      (Event t x, a))
-> ReaderT (LayoutCtx t) (VtyWidget t m) (Event t x, a)
-> DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m))
     (Event t x, a)
forall a b. (a -> b) -> a -> b
$ VtyWidget t m (Event t x, a)
-> ReaderT (LayoutCtx t) (VtyWidget t m) (Event t x, a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (VtyWidget t m (Event t x, a)
 -> ReaderT (LayoutCtx t) (VtyWidget t m) (Event t x, a))
-> VtyWidget t m (Event t x, a)
-> ReaderT (LayoutCtx t) (VtyWidget t m) (Event t x, a)
forall a b. (a -> b) -> a -> b
$
    DynRegion t
-> Dynamic t Bool
-> VtyWidget t m (Event t x, a)
-> VtyWidget t m (Event t x, a)
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
reg (Demux t (Maybe NodeId) -> Maybe NodeId -> Dynamic t Bool
forall k1 (t :: k1) k2.
(Reflex t, Eq k2) =>
Demux t k2 -> k2 -> Dynamic t Bool
demuxed Demux t (Maybe NodeId)
focussed (Maybe NodeId -> Dynamic t Bool) -> Maybe NodeId -> Dynamic t Bool
forall a b. (a -> b) -> a -> b
$ NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just NodeId
nodeId) (VtyWidget t m (Event t x, a) -> VtyWidget t m (Event t x, a))
-> VtyWidget t m (Event t x, a) -> VtyWidget t m (Event t x, a)
forall a b. (a -> b) -> a -> b
$ VtyWidget t m (Event t x, a)
child
  EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  ()
-> Layout t m ()
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   ()
 -> Layout t m ())
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     ()
-> Layout t m ()
forall a b. (a -> b) -> a -> b
$ Event t (First NodeId)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     ()
forall t w (m :: * -> *). EventWriter t w m => Event t w -> m ()
tellEvent (Event t (First NodeId)
 -> EventWriterT
      t
      (First NodeId)
      (DynamicWriterT
         t
         (Endo [(NodeId, (Bool, Constraint))])
         (ReaderT (LayoutCtx t) (VtyWidget t m)))
      ())
-> Event t (First NodeId)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     ()
forall a b. (a -> b) -> a -> b
$ NodeId -> First NodeId
forall a. a -> First a
First NodeId
nodeId First NodeId -> Event t x -> Event t (First NodeId)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t x
focusReq
  a -> Layout t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Configuration options for and constraints on 'tile'
data TileConfig t = TileConfig
  { TileConfig t -> Dynamic t Constraint
_tileConfig_constraint :: Dynamic t Constraint
    -- ^ 'Constraint' on the tile's size
  , TileConfig t -> Dynamic t Bool
_tileConfig_focusable :: Dynamic t Bool
    -- ^ Whether the tile is focusable
  }

instance Reflex t => Default (TileConfig t) where
  def :: TileConfig t
def = Dynamic t Constraint -> Dynamic t Bool -> TileConfig t
forall t. Dynamic t Constraint -> Dynamic t Bool -> TileConfig t
TileConfig (Constraint -> Dynamic t Constraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constraint -> Dynamic t Constraint)
-> Constraint -> Dynamic t Constraint
forall a b. (a -> b) -> a -> b
$ Int -> Constraint
Constraint_Min 0) (Bool -> Dynamic t Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)

-- | A 'tile' of a fixed size that is focusable and gains focus on click
fixed
  :: (Reflex t, Monad m, MonadNodeId m)
  => Dynamic t Int
  -> VtyWidget t m a
  -> Layout t m a
fixed :: Dynamic t Int -> VtyWidget t m a -> Layout t m a
fixed sz :: Dynamic t Int
sz = TileConfig t -> VtyWidget t m (Event t (), a) -> Layout t m a
forall t (m :: * -> *) x a.
(Reflex t, Monad m, MonadNodeId m) =>
TileConfig t -> VtyWidget t m (Event t x, a) -> Layout t m a
tile (TileConfig t
forall a. Default a => a
def { _tileConfig_constraint :: Dynamic t Constraint
_tileConfig_constraint =  Int -> Constraint
Constraint_Fixed (Int -> Constraint) -> Dynamic t Int -> Dynamic t Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
sz }) (VtyWidget t m (Event t (), a) -> Layout t m a)
-> (VtyWidget t m a -> VtyWidget t m (Event t (), a))
-> VtyWidget t m a
-> Layout t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VtyWidget t m a -> VtyWidget t m (Event t (), a)
forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
VtyWidget t m a -> VtyWidget t m (Event t (), a)
clickable

-- | A 'tile' that can stretch (i.e., has no fixed size) and has a minimum size of 0.
-- This tile is focusable and gains focus on click.
stretch
  :: (Reflex t, Monad m, MonadNodeId m)
  => VtyWidget t m a
  -> Layout t m a
stretch :: VtyWidget t m a -> Layout t m a
stretch = TileConfig t -> VtyWidget t m (Event t (), a) -> Layout t m a
forall t (m :: * -> *) x a.
(Reflex t, Monad m, MonadNodeId m) =>
TileConfig t -> VtyWidget t m (Event t x, a) -> Layout t m a
tile TileConfig t
forall a. Default a => a
def (VtyWidget t m (Event t (), a) -> Layout t m a)
-> (VtyWidget t m a -> VtyWidget t m (Event t (), a))
-> VtyWidget t m a
-> Layout t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VtyWidget t m a -> VtyWidget t m (Event t (), a)
forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
VtyWidget t m a -> VtyWidget t m (Event t (), a)
clickable

-- | A version of 'runLayout' that arranges tiles in a column and uses 'tabNavigation' to
-- change tile focus.
col
  :: (MonadFix m, MonadHold t m, PostBuild t m, MonadNodeId m)
  => Layout t m a
  -> VtyWidget t m a
col :: Layout t m a -> VtyWidget t m a
col child :: Layout t m a
child = do
  Event t Int
nav <- VtyWidget t m (Event t Int)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
VtyWidget t m (Event t Int)
tabNavigation
  Dynamic t Orientation
-> Int -> Event t Int -> Layout t m a -> VtyWidget t m a
forall (m :: * -> *) t a.
(MonadFix m, MonadHold t m, PostBuild t m, Monad m,
 MonadNodeId m) =>
Dynamic t Orientation
-> Int -> Event t Int -> Layout t m a -> VtyWidget t m a
runLayout (Orientation -> Dynamic t Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Orientation_Column) 0 Event t Int
nav Layout t m a
child

-- | A version of 'runLayout' that arranges tiles in a row and uses 'tabNavigation' to
-- change tile focus.
row
  :: (MonadFix m, MonadHold t m, PostBuild t m, MonadNodeId m)
  => Layout t m a
  -> VtyWidget t m a
row :: Layout t m a -> VtyWidget t m a
row child :: Layout t m a
child = do
  Event t Int
nav <- VtyWidget t m (Event t Int)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
VtyWidget t m (Event t Int)
tabNavigation
  Dynamic t Orientation
-> Int -> Event t Int -> Layout t m a -> VtyWidget t m a
forall (m :: * -> *) t a.
(MonadFix m, MonadHold t m, PostBuild t m, Monad m,
 MonadNodeId m) =>
Dynamic t Orientation
-> Int -> Event t Int -> Layout t m a -> VtyWidget t m a
runLayout (Orientation -> Dynamic t Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Orientation_Row) 0 Event t Int
nav Layout t m a
child

-- | Produces an 'Event' that navigates forward one tile when the Tab key is pressed
-- and backward one tile when Shift+Tab is pressed.
tabNavigation :: (Reflex t, Monad m) => VtyWidget t m (Event t Int)
tabNavigation :: VtyWidget t m (Event t Int)
tabNavigation = do
  Event t Int
fwd <- (KeyCombo -> Int) -> Event t KeyCombo -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> KeyCombo -> Int
forall a b. a -> b -> a
const 1) (Event t KeyCombo -> Event t Int)
-> VtyWidget t m (Event t KeyCombo) -> VtyWidget t m (Event t Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> VtyWidget t m (Event t KeyCombo)
forall (m :: * -> *) t.
(Monad m, Reflex t) =>
Key -> VtyWidget t m (Event t KeyCombo)
key (Char -> Key
V.KChar '\t')
  Event t Int
back <- (KeyCombo -> Int) -> Event t KeyCombo -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> KeyCombo -> Int
forall a b. a -> b -> a
const (-1)) (Event t KeyCombo -> Event t Int)
-> VtyWidget t m (Event t KeyCombo) -> VtyWidget t m (Event t Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> VtyWidget t m (Event t KeyCombo)
forall (m :: * -> *) t.
(Monad m, Reflex t) =>
Key -> VtyWidget t m (Event t KeyCombo)
key Key
V.KBackTab
  Event t Int -> VtyWidget t m (Event t Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t Int -> VtyWidget t m (Event t Int))
-> Event t Int -> VtyWidget t m (Event t Int)
forall a b. (a -> b) -> a -> 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]

-- | Captures the click event in a 'VtyWidget' context and returns it. Useful for
-- requesting focus when using 'tile'.
clickable
  :: (Reflex t, Monad m)
  => VtyWidget t m a
  -> VtyWidget t m (Event t (), a)
clickable :: VtyWidget t m a -> VtyWidget t m (Event t (), a)
clickable child :: VtyWidget t m a
child = do
  Event t MouseDown
click <- Button -> VtyWidget t m (Event t MouseDown)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Button -> VtyWidget t m (Event t MouseDown)
mouseDown Button
V.BLeft
  a
a <- VtyWidget t m a
child
  (Event t (), a) -> VtyWidget t m (Event t (), a)
forall (m :: * -> *) a. Monad m => a -> m a
return (() () -> Event t MouseDown -> Event t ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
click, a
a)

-- | Retrieve the current orientation of a 'Layout'
askOrientation :: Monad m => Layout t m (Dynamic t Orientation)
askOrientation :: Layout t m (Dynamic t Orientation)
askOrientation = EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  (Dynamic t Orientation)
-> Layout t m (Dynamic t Orientation)
forall t (m :: * -> *) a.
EventWriterT
  t
  (First NodeId)
  (DynamicWriterT
     t
     (Endo [(NodeId, (Bool, Constraint))])
     (ReaderT (LayoutCtx t) (VtyWidget t m)))
  a
-> Layout t m a
Layout (EventWriterT
   t
   (First NodeId)
   (DynamicWriterT
      t
      (Endo [(NodeId, (Bool, Constraint))])
      (ReaderT (LayoutCtx t) (VtyWidget t m)))
   (Dynamic t Orientation)
 -> Layout t m (Dynamic t Orientation))
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Dynamic t Orientation)
-> Layout t m (Dynamic t Orientation)
forall a b. (a -> b) -> a -> b
$ (LayoutCtx t -> Dynamic t Orientation)
-> EventWriterT
     t
     (First NodeId)
     (DynamicWriterT
        t
        (Endo [(NodeId, (Bool, Constraint))])
        (ReaderT (LayoutCtx t) (VtyWidget t m)))
     (Dynamic t Orientation)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LayoutCtx t -> Dynamic t Orientation
forall t. LayoutCtx t -> Dynamic t Orientation
_layoutCtx_orientation

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

-- | Compute the size of each widget "@k@" based on the total set of 'Constraint's
computeSizes
  :: Ord k
  => Int
  -> Map k (a, Constraint)
  -> Map k (a, Int)
computeSizes :: Int -> Map k (a, Constraint) -> Map k (a, Int)
computeSizes available :: Int
available constraints :: Map k (a, Constraint)
constraints =
  let minTotal :: Int
minTotal = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [(a, Constraint)] -> ((a, Constraint) -> Int) -> [Int]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Map k (a, Constraint) -> [(a, Constraint)]
forall k a. Map k a -> [a]
Map.elems Map k (a, Constraint)
constraints) (((a, Constraint) -> Int) -> [Int])
-> ((a, Constraint) -> Int) -> [Int]
forall a b. (a -> b) -> a -> b
$ \case
        (_, Constraint_Fixed n :: Int
n) -> Int
n
        (_, Constraint_Min n :: Int
n) -> Int
n
      leftover :: Int
leftover = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int
available Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minTotal)
      numStretch :: Int
numStretch = Map k (a, Constraint) -> Int
forall k a. Map k a -> Int
Map.size (Map k (a, Constraint) -> Int) -> Map k (a, Constraint) -> Int
forall a b. (a -> b) -> a -> b
$ ((a, Constraint) -> Bool)
-> Map k (a, Constraint) -> Map k (a, Constraint)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.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) Map k (a, Constraint)
constraints
      szStretch :: Int
szStretch = Ratio Int -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Ratio Int -> Int) -> Ratio Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
leftover Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
numStretch 1)
      adjustment :: Int
adjustment = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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, Map k (a, Int)) -> Map k (a, Int)
forall a b. (a, b) -> b
snd ((Int, Map k (a, Int)) -> Map k (a, Int))
-> (Int, Map k (a, Int)) -> Map k (a, Int)
forall a b. (a -> b) -> a -> b
$ (Int -> (a, Constraint) -> (Int, (a, Int)))
-> Int -> Map k (a, Constraint) -> (Int, Map k (a, Int))
forall a b c k. (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
Map.mapAccum (\adj :: Int
adj (a :: a
a, c :: Constraint
c) -> case Constraint
c of
      Constraint_Fixed n :: Int
n -> (Int
adj, (a
a, Int
n))
      Constraint_Min n :: Int
n -> (0, (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
adj))) Int
adjustment Map k (a, Constraint)
constraints
  where
    isMin :: Constraint -> Bool
isMin (Constraint_Min _) = Bool
True
    isMin _ = Bool
False

computeEdges :: (Ord k) => Map k (a, Int) -> Map k (a, (Int, Int))
computeEdges :: Map k (a, Int) -> Map k (a, (Int, Int))
computeEdges = (Map k (a, (Int, Int)), Int) -> Map k (a, (Int, Int))
forall a b. (a, b) -> a
fst ((Map k (a, (Int, Int)), Int) -> Map k (a, (Int, Int)))
-> (Map k (a, Int) -> (Map k (a, (Int, Int)), Int))
-> Map k (a, Int)
-> Map k (a, (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map k (a, (Int, Int)), Int)
 -> k -> (a, Int) -> (Map k (a, (Int, Int)), Int))
-> (Map k (a, (Int, Int)), Int)
-> Map k (a, Int)
-> (Map k (a, (Int, Int)), Int)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\(m :: Map k (a, (Int, Int))
m, offset :: Int
offset) k :: k
k (a :: a
a, sz :: Int
sz) ->
  (k
-> (a, (Int, Int))
-> Map k (a, (Int, Int))
-> Map k (a, (Int, Int))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k (a
a, (Int
offset, Int
sz)) Map k (a, (Int, Int))
m, Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)) (Map k (a, (Int, Int))
forall k a. Map k a
Map.empty, 0)