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

-- |
-- Module      : FULE.Container.Arrayed
-- Description : The @Arrayed@ Container.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- A 'FULE.Container.Container' to display items one after another, either
-- vertically or horizontally. Items are spaced according to their inherent sizes.
--
-- You may also wish to consider a 'FULE.Container.Grid.Grid'.
module FULE.Container.Arrayed
 ( ArrayedM
 , Arrayed
 , arrayedHoriz
 , arrayedVert
 ) where

import Control.Monad
import Control.Monad.Trans.Class
import Data.Foldable
import Data.Functor.Identity
import Data.Maybe
import Data.Proxy

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


-- | An array (horizontal or vertical) of visual 'FULE.Container.Item.ItemM's
--   in a layout. Each item will occupy a different amount of space in the array;
--   if you wish each item to be evenly spaced, use a 'FULE.Container.Grid.Grid'
--   instead.
data ArrayedM m k
  = Arrayed
    { forall (m :: * -> *) k. ArrayedM m k -> Int
horizPaddingOf :: Int
    , forall (m :: * -> *) k. ArrayedM m k -> Int
vertPaddingOf :: Int
    , forall (m :: * -> *) k. ArrayedM m k -> Orientation
orientationOf :: Orientation
    , forall (m :: * -> *) k. ArrayedM m k -> [ItemM m k]
itemsOf :: [ItemM m k]
    }

-- | Like 'ArrayedM' but run in the 'Data.Functor.Identity.Identity' monad.
type Arrayed = ArrayedM Identity

-- NOTE: no padding is added when there are no items to display
instance (Monad m) => Container (ArrayedM m k) k m where
  minWidth :: ArrayedM m k -> Proxy k -> m (Maybe Int)
minWidth (Arrayed Int
h Int
v Orientation
o [ItemM m k]
is) Proxy k
proxy = case Orientation
o of
    Orientation
Horizontal -> do
      let padding :: Int
padding = ([ItemM m k] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ItemM m k]
is Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h
      (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. Num a => a -> a -> a
+ Int
padding) (Maybe Int -> Maybe Int)
-> ([Maybe Int] -> Maybe Int) -> [Maybe Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> Maybe Int
getTotalSize ([Maybe Int] -> Maybe Int) -> m [Maybe Int] -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ItemM m k -> m (Maybe Int)) -> [ItemM m k] -> m [Maybe Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ItemM m k -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
`minWidth` Proxy k
proxy) [ItemM m k]
is
    Orientation
Vertical -> do
      let padding :: Int
padding = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h
      (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. Num a => a -> a -> a
+ Int
padding) (Maybe Int -> Maybe Int)
-> ([Maybe Int] -> Maybe Int) -> [Maybe Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> Maybe Int
getMaxSize ([Maybe Int] -> Maybe Int) -> m [Maybe Int] -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ItemM m k -> m (Maybe Int)) -> [ItemM m k] -> m [Maybe Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ItemM m k -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
`minWidth` Proxy k
proxy) [ItemM m k]
is
  minHeight :: ArrayedM m k -> Proxy k -> m (Maybe Int)
minHeight (Arrayed Int
h Int
v Orientation
o [ItemM m k]
is) Proxy k
proxy = case Orientation
o of
    Orientation
Horizontal -> do
      let padding :: Int
padding = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
v
      (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. Num a => a -> a -> a
+ Int
padding) (Maybe Int -> Maybe Int)
-> ([Maybe Int] -> Maybe Int) -> [Maybe Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> Maybe Int
getMaxSize ([Maybe Int] -> Maybe Int) -> m [Maybe Int] -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ItemM m k -> m (Maybe Int)) -> [ItemM m k] -> m [Maybe Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ItemM m k -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
`minHeight` Proxy k
proxy) [ItemM m k]
is
    Orientation
Vertical -> do
      let padding :: Int
padding = ([ItemM m k] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ItemM m k]
is Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
v
      (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. Num a => a -> a -> a
+ Int
padding) (Maybe Int -> Maybe Int)
-> ([Maybe Int] -> Maybe Int) -> [Maybe Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> Maybe Int
getTotalSize ([Maybe Int] -> Maybe Int) -> m [Maybe Int] -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ItemM m k -> m (Maybe Int)) -> [ItemM m k] -> m [Maybe Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ItemM m k -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
`minHeight` Proxy k
proxy) [ItemM m k]
is
  addToLayout :: ArrayedM m k -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout (Arrayed Int
h Int
v Orientation
o [ItemM m k]
is) Proxy k
proxy Bounds
bounds Maybe Int
renderGroup = Bool -> LayoutOp k m () -> LayoutOp k m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ItemM m k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ItemM m k]
is) do
    let (GuideID
refBoundingGuide, Bounds -> GuideID
getRefBoundingGuide) = case Orientation
o of
          Orientation
Horizontal -> (Bounds -> GuideID
leftOf Bounds
bounds, Bounds -> GuideID
rightOf)
          Orientation
Vertical -> (Bounds -> GuideID
topOf Bounds
bounds, Bounds -> GuideID
bottomOf)
    let clipping :: Maybe Bounds
clipping = Bounds -> Maybe Bounds
clippingOf Bounds
bounds
    GuideID
alignmentGuide <- case Orientation
o of
      Orientation
Horizontal -> GuideSpecification
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID)
-> GuideSpecification
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
v (Bounds -> GuideID
topOf Bounds
bounds) PlasticDependencyType
Asymmetric
      Orientation
Vertical -> GuideSpecification
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID)
-> GuideSpecification
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
h (Bounds -> GuideID
leftOf Bounds
bounds) PlasticDependencyType
Asymmetric
    GuideID
-> [ItemM m k]
-> (GuideID
    -> ItemM m k
    -> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID)
-> LayoutOp k m ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
b -> t a -> (b -> a -> m b) -> m ()
loopingWith GuideID
refBoundingGuide [ItemM m k]
is ((GuideID
  -> ItemM m k
  -> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID)
 -> LayoutOp k m ())
-> (GuideID
    -> ItemM m k
    -> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID)
-> LayoutOp k m ()
forall a b. (a -> b) -> a -> b
$ \GuideID
refBoundingGuide ItemM m k
i -> do
      Bounds
bounds <- Int
-> Int
-> Orientation
-> GuideID
-> GuideID
-> ItemM m k
-> Proxy k
-> Maybe Bounds
-> LayoutOp k m Bounds
forall (m :: * -> *) k.
Monad m =>
Int
-> Int
-> Orientation
-> GuideID
-> GuideID
-> ItemM m k
-> Proxy k
-> Maybe Bounds
-> LayoutOp k m Bounds
makeBounds Int
h Int
v Orientation
o GuideID
alignmentGuide GuideID
refBoundingGuide ItemM m k
i Proxy k
proxy Maybe Bounds
clipping
      ItemM m k -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout ItemM m k
i Proxy k
proxy Bounds
bounds Maybe Int
renderGroup
      GuideID
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bounds -> GuideID
getRefBoundingGuide Bounds
bounds)

loopingWith :: (Foldable t, Monad m) => b -> t a -> (b -> a -> m b) -> m ()
loopingWith :: forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
b -> t a -> (b -> a -> m b) -> m ()
loopingWith b
b t a
as b -> a -> m b
f = m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((b -> a -> m b) -> b -> t a -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM b -> a -> m b
f b
b t a
as)

makeBounds
  :: (Monad m)
  => Int -> Int -> Orientation -> GuideID -> GuideID -> ItemM m k -> Proxy k
  -> Maybe Bounds
  -> LayoutOp k m Bounds
makeBounds :: forall (m :: * -> *) k.
Monad m =>
Int
-> Int
-> Orientation
-> GuideID
-> GuideID
-> ItemM m k
-> Proxy k
-> Maybe Bounds
-> LayoutOp k m Bounds
makeBounds Int
horiz Int
vert Orientation
dir GuideID
alignmentGuide GuideID
refBoundingGuide ItemM m k
i Proxy k
proxy Maybe Bounds
clipping = do
  Int
width <- (Maybe Int -> Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int
forall a b.
(a -> b)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0) (StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int)
-> (m (Maybe Int)
    -> StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int))
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [ComponentInfo k] m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] 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 k] m (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int))
-> (m (Maybe Int) -> WriterT [ComponentInfo k] m (Maybe Int))
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe Int) -> WriterT [ComponentInfo k] m (Maybe Int)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ComponentInfo k] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int)
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int
forall a b. (a -> b) -> a -> b
$ ItemM m k -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minWidth ItemM m k
i Proxy k
proxy
  Int
height <- (Maybe Int -> Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int
forall a b.
(a -> b)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0) (StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int)
-> (m (Maybe Int)
    -> StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int))
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [ComponentInfo k] m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] 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 k] m (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int))
-> (m (Maybe Int) -> WriterT [ComponentInfo k] m (Maybe Int))
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe Int) -> WriterT [ComponentInfo k] m (Maybe Int)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ComponentInfo k] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Int)
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int)
-> m (Maybe Int)
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) Int
forall a b. (a -> b) -> a -> b
$ ItemM m k -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minHeight ItemM m k
i Proxy k
proxy
  case Orientation
dir of
    Orientation
Horizontal -> do
      GuideID
boundingGuide <-
        if Int
horiz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
horiz GuideID
refBoundingGuide PlasticDependencyType
Asymmetric
        else GuideID -> LayoutOp k m GuideID
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return GuideID
refBoundingGuide
      GuideID
right <- GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
width GuideID
boundingGuide PlasticDependencyType
Asymmetric
      GuideID
bottom <- GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
height GuideID
alignmentGuide PlasticDependencyType
Asymmetric
      Bounds -> LayoutOp k m Bounds
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuideID -> GuideID -> GuideID -> GuideID -> Maybe Bounds -> Bounds
Bounds GuideID
alignmentGuide GuideID
boundingGuide GuideID
right GuideID
bottom Maybe Bounds
clipping)
    Orientation
Vertical -> do
      GuideID
boundingGuide <-
        if Int
vert Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
vert GuideID
refBoundingGuide PlasticDependencyType
Asymmetric
        else GuideID -> LayoutOp k m GuideID
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return GuideID
refBoundingGuide
      GuideID
right <- GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
width GuideID
alignmentGuide PlasticDependencyType
Asymmetric
      GuideID
bottom <- GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideID -> PlasticDependencyType -> GuideSpecification
Relative Int
height GuideID
boundingGuide PlasticDependencyType
Asymmetric
      Bounds -> LayoutOp k m Bounds
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuideID -> GuideID -> GuideID -> GuideID -> Maybe Bounds -> Bounds
Bounds GuideID
boundingGuide GuideID
alignmentGuide GuideID
right GuideID
bottom Maybe Bounds
clipping)

-- | Array 'FULE.Container.Item.ItemM's horizontally with the specified padding.
--
--   Padding is added between the elements and around the perimeter of the array;
--   the horizontal padding is added once between elements, and the same padding
--   is used before and after the array -- thus the intra-element padding is not
--   double the outside padding.
arrayedHoriz :: Padding -> [ItemM m k] -> ArrayedM m k
arrayedHoriz :: forall (m :: * -> *) k. Padding -> [ItemM m k] -> ArrayedM m k
arrayedHoriz Padding
padding = Padding -> Orientation -> [ItemM m k] -> ArrayedM m k
forall (m :: * -> *) k.
Padding -> Orientation -> [ItemM m k] -> ArrayedM m k
arrayed Padding
padding Orientation
Horizontal

-- | Array 'FULE.Container.Item.ItemM's vertically with the specified padding.
--
--   Padding is added between the elements and around the perimeter of the array;
--   the vertical padding is added once between elements, and the same padding
--   is used before and after the array -- thus the intra-element padding is not
--   double the outside padding.
arrayedVert :: Padding -> [ItemM m k] -> ArrayedM m k
arrayedVert :: forall (m :: * -> *) k. Padding -> [ItemM m k] -> ArrayedM m k
arrayedVert Padding
padding = Padding -> Orientation -> [ItemM m k] -> ArrayedM m k
forall (m :: * -> *) k.
Padding -> Orientation -> [ItemM m k] -> ArrayedM m k
arrayed Padding
padding Orientation
Vertical

arrayed :: Padding -> Orientation -> [ItemM m k] -> ArrayedM m k
arrayed :: forall (m :: * -> *) k.
Padding -> Orientation -> [ItemM m k] -> ArrayedM m k
arrayed (Int
horiz, Int
vert) = Int -> Int -> Orientation -> [ItemM m k] -> ArrayedM m k
forall (m :: * -> *) k.
Int -> Int -> Orientation -> [ItemM m k] -> ArrayedM m k
Arrayed (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
horiz) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
vert)