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

-- |
-- Module      : FULE.Container.Divided
-- Description : The @Divided@ Container.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- A 'FULE.Container.Container' that is divided in half, horizontally or vertically.
module FULE.Container.Divided
 ( Divided
 , BarControlGen
 , Dynamics
 , dynamic
 , static
 , sizedTop
 , sizedLeft
 , sizedRight
 , sizedBottom
 ) where

import Control.Applicative
import Control.Monad.Trans.Class
import Data.Maybe
import Data.Proxy

import FULE.Component
import FULE.Container
import FULE.Container.Config
import FULE.Internal.Util
import FULE.Layout
import FULE.LayoutOp


data SizedSide = SizedTop | SizedLeft | SizedRight | SizedBottom


-- | Type of a function to produce a 'FULE.Component.Component' for controlling
--   the resize bar, thus leaving the mechanics and presentation up to you.
type BarControlGen b
  = Orientation
  -- ^ The orientation of the resize bar; a @Horizontal@ orientation would call
  --   for vertical movement, so should be paired with watching for changes in
  --   the @y@ axis, and likewise with @Vertical@ and the @x@ axis.
  -> GuideID
  -- ^ A Guide associated with the resize bar that should be updated with a
  --   delta when the bar is moved.
  -> b -- ^ The bar component to be added to the layout.

-- | A specification of whether the sized portion of the container should be
--   resizable and how the resize bar, if any, should be sized and controlled.
data Dynamics b
  = Dynamic
    { forall b. Dynamics b -> BarControlGen b
barGenOf :: BarControlGen b
    , forall b. Dynamics b -> Int
barSizeOf :: Int
    }
  | Static

barSizeFor :: Dynamics b -> Maybe Int
barSizeFor :: forall b. Dynamics b -> Maybe Int
barSizeFor (Dynamic BarControlGen b
_ Int
s) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
s
barSizeFor Dynamics b
Static = Maybe Int
forall a. Maybe a
Nothing

-- | Use a dynamic sizing, with a resize bar, for the sized portion of the
--   container.
dynamic
  :: BarControlGen b
  -- ^ A function to generate a @Component@ to use for the resize bar.
  -> Int
  -- ^ The thickness of the resize bar @Component@ in the direction of travel.
  -> Dynamics b
dynamic :: forall b. BarControlGen b -> Int -> Dynamics b
dynamic BarControlGen b
genBar Int
size = BarControlGen b -> Int -> Dynamics b
forall b. BarControlGen b -> Int -> Dynamics b
Dynamic BarControlGen b
genBar (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
size)

-- | Use a static size for the sized portion of the container.
static :: Dynamics b
static :: forall b. Dynamics b
static = Dynamics b
forall b. Dynamics b
Static


-- | A container divided (horizontally or vertically) into two parts with one
--   of the parts having a set size (height or width) and the other part
--   resizing dynamically.
--
--   When configured to be resizable, the resize bar's size is not included in
--   the size of the sized content during layout but is treated as an additional
--   size to be considered.
data Divided s b u
  = Divided
    { forall s b u. Divided s b u -> SizedSide
sizedSideOf :: SizedSide
    , forall s b u. Divided s b u -> Maybe Int
sizeOf :: SizedContentSize Int
    , forall s b u. Divided s b u -> Dynamics b
dynamicsOf :: Dynamics b
    , forall s b u. Divided s b u -> s
sizedContentOf :: s
    , forall s b u. Divided s b u -> u
unconstrainedContentOf :: u
    }

instance (Container s b m, Container u b m) => Container (Divided s b u) b m where
  minWidth :: Divided s b u -> Proxy b -> m (Maybe Int)
minWidth Divided s b u
divided Proxy b
proxy = do
    Maybe Int
sizedWidth <- s -> Proxy b -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minWidth (Divided s b u -> s
forall s b u. Divided s b u -> s
sizedContentOf Divided s b u
divided) Proxy b
proxy
    let barSize :: Maybe Int
barSize = Dynamics b -> Maybe Int
forall b. Dynamics b -> Maybe Int
barSizeFor (Divided s b u -> Dynamics b
forall s b u. Divided s b u -> Dynamics b
dynamicsOf Divided s b u
divided)
    let sizedWidth' :: Maybe Int
sizedWidth' = [Maybe Int] -> Maybe Int
getTotalSize [Divided s b u -> Maybe Int
forall s b u. Divided s b u -> Maybe Int
sizeOf Divided s b u
divided Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
sizedWidth, Maybe Int
barSize]
    case Divided s b u -> SizedSide
forall s b u. Divided s b u -> SizedSide
sizedSideOf Divided s b u
divided of
      SizedSide
SizedLeft  -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
sizedWidth'
      SizedSide
SizedRight -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
sizedWidth'
      SizedSide
_          -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
sizedWidth
  minHeight :: Divided s b u -> Proxy b -> m (Maybe Int)
minHeight Divided s b u
divided Proxy b
proxy = do
    Maybe Int
sizedHeight <- s -> Proxy b -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minHeight (Divided s b u -> s
forall s b u. Divided s b u -> s
sizedContentOf Divided s b u
divided) Proxy b
proxy
    let barSize :: Maybe Int
barSize = Dynamics b -> Maybe Int
forall b. Dynamics b -> Maybe Int
barSizeFor (Divided s b u -> Dynamics b
forall s b u. Divided s b u -> Dynamics b
dynamicsOf Divided s b u
divided)
    let sizedHeight' :: Maybe Int
sizedHeight' = [Maybe Int] -> Maybe Int
getTotalSize [Divided s b u -> Maybe Int
forall s b u. Divided s b u -> Maybe Int
sizeOf Divided s b u
divided Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
sizedHeight, Maybe Int
barSize]
    case Divided s b u -> SizedSide
forall s b u. Divided s b u -> SizedSide
sizedSideOf Divided s b u
divided of
      SizedSide
SizedTop    -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
sizedHeight'
      SizedSide
SizedBottom -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
sizedHeight'
      SizedSide
_           -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
sizedHeight
  addToLayout :: Divided s b u -> Proxy b -> Bounds -> Maybe Int -> LayoutOp b m ()
addToLayout Divided s b u
divided Proxy b
proxy Bounds
bounds Maybe Int
renderGroup =
    case Divided s b u -> SizedSide
forall s b u. Divided s b u -> SizedSide
sizedSideOf Divided s b u
divided of
      SizedSide
SizedTop -> Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
forall s b (m :: * -> *) u.
(Container s b m, Container u b m) =>
Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
makeDivided Divided s b u
divided Proxy b
proxy Bounds
bounds Maybe Int
renderGroup
        DivisionConfig
        { setUnconInnerOf :: GuideID -> Bounds -> Bounds
setUnconInnerOf = \GuideID
g Bounds
b -> Bounds
b { topOf = g }
        , getUnconOuterOf :: Bounds -> GuideID
getUnconOuterOf = Bounds -> GuideID
bottomOf
        , setSizedInnerOf :: GuideID -> Bounds -> Bounds
setSizedInnerOf = \GuideID
g Bounds
b -> Bounds
b { bottomOf = g }
        , getSizedOuterOf :: Bounds -> GuideID
getSizedOuterOf = Bounds -> GuideID
topOf
        , multiplierOf :: Int
multiplierOf = Int
1
        , orientationOf :: Orientation
orientationOf = Orientation
Horizontal
        }
      SizedSide
SizedLeft -> Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
forall s b (m :: * -> *) u.
(Container s b m, Container u b m) =>
Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
makeDivided Divided s b u
divided Proxy b
proxy Bounds
bounds Maybe Int
renderGroup
        DivisionConfig
        { setUnconInnerOf :: GuideID -> Bounds -> Bounds
setUnconInnerOf = \GuideID
g Bounds
b -> Bounds
b { leftOf = g }
        , getUnconOuterOf :: Bounds -> GuideID
getUnconOuterOf = Bounds -> GuideID
rightOf
        , setSizedInnerOf :: GuideID -> Bounds -> Bounds
setSizedInnerOf = \GuideID
g Bounds
b -> Bounds
b { rightOf = g }
        , getSizedOuterOf :: Bounds -> GuideID
getSizedOuterOf = Bounds -> GuideID
leftOf
        , multiplierOf :: Int
multiplierOf = Int
1
        , orientationOf :: Orientation
orientationOf = Orientation
Vertical
        }
      SizedSide
SizedRight -> Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
forall s b (m :: * -> *) u.
(Container s b m, Container u b m) =>
Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
makeDivided Divided s b u
divided Proxy b
proxy Bounds
bounds Maybe Int
renderGroup
        DivisionConfig
        { setUnconInnerOf :: GuideID -> Bounds -> Bounds
setUnconInnerOf = \GuideID
g Bounds
b -> Bounds
b { rightOf = g }
        , getUnconOuterOf :: Bounds -> GuideID
getUnconOuterOf = Bounds -> GuideID
leftOf
        , setSizedInnerOf :: GuideID -> Bounds -> Bounds
setSizedInnerOf = \GuideID
g Bounds
b -> Bounds
b { leftOf = g }
        , getSizedOuterOf :: Bounds -> GuideID
getSizedOuterOf = Bounds -> GuideID
rightOf
        , multiplierOf :: Int
multiplierOf = -Int
1
        , orientationOf :: Orientation
orientationOf = Orientation
Vertical
        }
      SizedSide
SizedBottom -> Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
forall s b (m :: * -> *) u.
(Container s b m, Container u b m) =>
Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
makeDivided Divided s b u
divided Proxy b
proxy Bounds
bounds Maybe Int
renderGroup
        DivisionConfig
        { setUnconInnerOf :: GuideID -> Bounds -> Bounds
setUnconInnerOf = \GuideID
g Bounds
b -> Bounds
b { bottomOf = g }
        , getUnconOuterOf :: Bounds -> GuideID
getUnconOuterOf = Bounds -> GuideID
topOf
        , setSizedInnerOf :: GuideID -> Bounds -> Bounds
setSizedInnerOf = \GuideID
g Bounds
b -> Bounds
b { topOf = g }
        , getSizedOuterOf :: Bounds -> GuideID
getSizedOuterOf = Bounds -> GuideID
bottomOf
        , multiplierOf :: Int
multiplierOf = -Int
1
        , orientationOf :: Orientation
orientationOf = Orientation
Horizontal
        }


data DivisionConfig
  = DivisionConfig
    { DivisionConfig -> GuideID -> Bounds -> Bounds
setUnconInnerOf :: GuideID -> Bounds -> Bounds
    , DivisionConfig -> Bounds -> GuideID
getUnconOuterOf :: Bounds -> GuideID
    , DivisionConfig -> GuideID -> Bounds -> Bounds
setSizedInnerOf :: GuideID -> Bounds -> Bounds
    , DivisionConfig -> Bounds -> GuideID
getSizedOuterOf :: Bounds -> GuideID
    , DivisionConfig -> Int
multiplierOf :: Int
    , DivisionConfig -> Orientation
orientationOf :: Orientation
    }

makeDivided
 :: (Container s b m, Container u b m)
 => Divided s b u -> Proxy b -> Bounds -> RenderGroup -> DivisionConfig -> LayoutOp b m ()
makeDivided :: forall s b (m :: * -> *) u.
(Container s b m, Container u b m) =>
Divided s b u
-> Proxy b
-> Bounds
-> Maybe Int
-> DivisionConfig
-> LayoutOp b m ()
makeDivided Divided s b u
divided Proxy b
proxy Bounds
bounds Maybe Int
renderGroup DivisionConfig
config = do
  -- sized
  Maybe Int
dim <- case Orientation
orientation of
    -- a Horizontal `orientation` means we're split horizontally so should get the height
    -- and likewise for Vertical and width
    Orientation
Horizontal -> WriterT [ComponentInfo b] m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int)
forall (m :: * -> *) a. Monad m => m a -> StateT LayoutOpState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [ComponentInfo b] m (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int))
-> (m (Maybe Int) -> WriterT [ComponentInfo b] m (Maybe Int))
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe Int) -> WriterT [ComponentInfo b] m (Maybe Int)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ComponentInfo b] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int))
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int)
forall a b. (a -> b) -> a -> b
$ s -> Proxy b -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minHeight s
sized Proxy b
proxy
    Orientation
Vertical -> WriterT [ComponentInfo b] m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int)
forall (m :: * -> *) a. Monad m => m a -> StateT LayoutOpState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [ComponentInfo b] m (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int))
-> (m (Maybe Int) -> WriterT [ComponentInfo b] m (Maybe Int))
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe Int) -> WriterT [ComponentInfo b] m (Maybe Int)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ComponentInfo b] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int))
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo b] m) (Maybe Int)
forall a b. (a -> b) -> a -> b
$ s -> Proxy b -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minWidth s
sized Proxy b
proxy
  let size' :: Int
size' = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int
size Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
dim)
  GuideID
sizedInner <- GuideSpecification -> LayoutOp b m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp b m GuideID)
-> GuideSpecification -> LayoutOp b m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
size' (Bounds -> GuideID
getSizedOuter Bounds
bounds) PlasticDependencyType
Asymmetric
  s -> Proxy b -> Bounds -> Maybe Int -> LayoutOp b m ()
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout s
sized Proxy b
proxy (GuideID -> Bounds -> Bounds
setSizedInner GuideID
sizedInner Bounds
bounds) Maybe Int
renderGroup
  -- bar
  GuideID
unconstrainedInner <- case Dynamics b
dynamics of
    Dynamic BarControlGen b
genBar Int
barSize -> do
      GuideID
barUncon <- GuideSpecification -> LayoutOp b m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp b m GuideID)
-> GuideSpecification -> LayoutOp b m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
barSize) GuideID
sizedInner PlasticDependencyType
Symmetric
      -- yes the 'sized' and 'unconstrained' are supposed to be mixed here:
      let barBounds :: Bounds
barBounds = GuideID -> Bounds -> Bounds
setSizedInner GuideID
barUncon (Bounds -> Bounds) -> (Bounds -> Bounds) -> Bounds -> Bounds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuideID -> Bounds -> Bounds
setUnconInner GuideID
sizedInner (Bounds -> Bounds) -> Bounds -> Bounds
forall a b. (a -> b) -> a -> b
$ Bounds
bounds
      b -> Proxy b -> Bounds -> Maybe Int -> LayoutOp b m ()
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout (BarControlGen b
genBar Orientation
orientation GuideID
sizedInner) Proxy b
proxy Bounds
barBounds Maybe Int
renderGroup
      GuideConstraint -> LayoutOp b m ()
forall (m :: * -> *) k.
Monad m =>
GuideConstraint -> LayoutOp k m ()
addGuideConstraintToLayout (GuideConstraint -> LayoutOp b m ())
-> GuideConstraint -> LayoutOp b m ()
forall a b. (a -> b) -> a -> b
$ GuideID
barUncon GuideID -> GuideID -> GuideConstraint
`unconConstraint` Bounds -> GuideID
getUnconOuter Bounds
bounds
      GuideConstraint -> LayoutOp b m ()
forall (m :: * -> *) k.
Monad m =>
GuideConstraint -> LayoutOp k m ()
addGuideConstraintToLayout (GuideConstraint -> LayoutOp b m ())
-> GuideConstraint -> LayoutOp b m ()
forall a b. (a -> b) -> a -> b
$ GuideID
sizedInner GuideID -> GuideID -> GuideConstraint
`sizedConstraint` Bounds -> GuideID
getSizedOuter Bounds
bounds
      GuideID -> LayoutOp b m GuideID
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo b] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return GuideID
barUncon
    Dynamics b
Static -> GuideID -> LayoutOp b m GuideID
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo b] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return GuideID
sizedInner
  -- unconstrained
  u -> Proxy b -> Bounds -> Maybe Int -> LayoutOp b m ()
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout u
unconstrained Proxy b
proxy (GuideID -> Bounds -> Bounds
setUnconInner GuideID
unconstrainedInner Bounds
bounds) Maybe Int
renderGroup
  where
    Divided
      { sizeOf :: forall s b u. Divided s b u -> Maybe Int
sizeOf = Maybe Int
size
      , dynamicsOf :: forall s b u. Divided s b u -> Dynamics b
dynamicsOf = Dynamics b
dynamics
      , sizedContentOf :: forall s b u. Divided s b u -> s
sizedContentOf = s
sized
      , unconstrainedContentOf :: forall s b u. Divided s b u -> u
unconstrainedContentOf = u
unconstrained
      } = Divided s b u
divided
    DivisionConfig
      { setUnconInnerOf :: DivisionConfig -> GuideID -> Bounds -> Bounds
setUnconInnerOf = GuideID -> Bounds -> Bounds
setUnconInner
      , getUnconOuterOf :: DivisionConfig -> Bounds -> GuideID
getUnconOuterOf = Bounds -> GuideID
getUnconOuter
      , setSizedInnerOf :: DivisionConfig -> GuideID -> Bounds -> Bounds
setSizedInnerOf = GuideID -> Bounds -> Bounds
setSizedInner
      , getSizedOuterOf :: DivisionConfig -> Bounds -> GuideID
getSizedOuterOf = Bounds -> GuideID
getSizedOuter
      , multiplierOf :: DivisionConfig -> Int
multiplierOf = Int
m
      , orientationOf :: DivisionConfig -> Orientation
orientationOf = Orientation
orientation
      } = DivisionConfig
config
    (GuideID -> GuideID -> GuideConstraint
unconConstraint, GuideID -> GuideID -> GuideConstraint
sizedConstraint) = if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then (GuideID -> GuideID -> GuideConstraint
LTE, GuideID -> GuideID -> GuideConstraint
GTE) else (GuideID -> GuideID -> GuideConstraint
GTE, GuideID -> GuideID -> GuideConstraint
LTE)


-- | Create a 'Divided' container with the top portion having a particular size.
sizedTop
  :: SizedContentSize Int -- ^ The size of the sized content.
  -> Dynamics b -- ^ The dynamics of the @Divided@ container.
  -> s -- ^ The sized content.
  -> u -- ^ The dynamic content.
  -> Divided s b u
sizedTop :: forall b s u. Maybe Int -> Dynamics b -> s -> u -> Divided s b u
sizedTop = SizedSide -> Maybe Int -> Dynamics b -> s -> u -> Divided s b u
forall s b u.
SizedSide -> Maybe Int -> Dynamics b -> s -> u -> Divided s b u
Divided SizedSide
SizedTop (Maybe Int -> Dynamics b -> s -> u -> Divided s b u)
-> (Maybe Int -> Maybe Int)
-> Maybe Int
-> Dynamics b
-> s
-> u
-> Divided s b u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0)

-- | Create a 'Divided' container with the left portion having a particular size.
sizedLeft
  :: SizedContentSize Int -- ^ The size of the sized content.
  -> Dynamics b -- ^ The dynamics of the @Divided@ container.
  -> s -- ^ The sized content.
  -> u -- ^ The dynamic content.
  -> Divided s b u
sizedLeft :: forall b s u. Maybe Int -> Dynamics b -> s -> u -> Divided s b u
sizedLeft = SizedSide -> Maybe Int -> Dynamics b -> s -> u -> Divided s b u
forall s b u.
SizedSide -> Maybe Int -> Dynamics b -> s -> u -> Divided s b u
Divided SizedSide
SizedLeft (Maybe Int -> Dynamics b -> s -> u -> Divided s b u)
-> (Maybe Int -> Maybe Int)
-> Maybe Int
-> Dynamics b
-> s
-> u
-> Divided s b u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0)

-- | Create a 'Divided' container with the right portion having a particular size.
sizedRight
  :: SizedContentSize Int -- ^ The size of the sized content.
  -> Dynamics b -- ^ The dynamics of the @Divided@ container.
  -> s -- ^ The sized content.
  -> u -- ^ The dynamic content.
  -> Divided s b u
sizedRight :: forall b s u. Maybe Int -> Dynamics b -> s -> u -> Divided s b u
sizedRight = SizedSide -> Maybe Int -> Dynamics b -> s -> u -> Divided s b u
forall s b u.
SizedSide -> Maybe Int -> Dynamics b -> s -> u -> Divided s b u
Divided SizedSide
SizedRight (Maybe Int -> Dynamics b -> s -> u -> Divided s b u)
-> (Maybe Int -> Maybe Int)
-> Maybe Int
-> Dynamics b
-> s
-> u
-> Divided s b u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0)

-- | Create a 'Divided' container with the bottom portion having a particular size.
sizedBottom
  :: SizedContentSize Int -- ^ The size of the sized content.
  -> Dynamics b -- ^ The dynamics of the @Divided@ container.
  -> s -- ^ The sized content.
  -> u -- ^ The dynamic content.
  -> Divided s b u
sizedBottom :: forall b s u. Maybe Int -> Dynamics b -> s -> u -> Divided s b u
sizedBottom = SizedSide -> Maybe Int -> Dynamics b -> s -> u -> Divided s b u
forall s b u.
SizedSide -> Maybe Int -> Dynamics b -> s -> u -> Divided s b u
Divided SizedSide
SizedBottom (Maybe Int -> Dynamics b -> s -> u -> Divided s b u)
-> (Maybe Int -> Maybe Int)
-> Maybe Int
-> Dynamics b
-> s
-> u
-> Divided s b u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0)