-- | Layout formula positioning children horizontally or vertically, with or without wrapping.
module Graphics.Layout.Flex(
        Flex(..), FlexChild(..), Direction(..), FlexWrapping(..), Justification(..), Alignment(..),
        flexMap, flexResolve, flexMaxBasis, flexSumBasis, flexWrap, flexRowSize, flexRowsSize,
        justifyOffset, justifySpacing, flexJustify, alignOffset,
        outerMinMain, outerMain, outerMaxMain, outerMinCross, outerCross, outerMaxCross,
        innerMinMain, innerMain, innerMaxMain, innerMinCross, innerCross, innerMaxCross,
        flexGetBox, flexSplit, flexPosition) where

import Graphics.Layout.Box as B (Length(..), lowerLength, Size(..), PaddedBox(..),
        maxWidth, width, minWidth, maxHeight, height, minHeight, CastDouble(..), Zero(..))
import Data.List (intersperse)
import GHC.Real (infinity)
import Data.Maybe (fromMaybe)

-- | Parameters to flexbox layout
data Flex a b = Flex {
    -- | On which axis to position children
    forall a b. Flex a b -> Direction
direction :: Direction,
    -- | Whether to reverse each row
    forall a b. Flex a b -> Bool
reverseRows :: Bool,
    -- | Whether to wrap children to multiple lines
    forall a b. Flex a b -> FlexWrapping
wrap :: FlexWrapping,
    -- | How to justify children within lines
    forall a b. Flex a b -> Justification
justify :: Justification,
    -- | How to justify lines within the flexbox. Nothing is CSS "stretch".
    forall a b. Flex a b -> Maybe Justification
alignLines :: Maybe Justification,
    -- | Gap between children
    forall a b. Flex a b -> b
baseGap :: b,
    -- | Gap between lines
    forall a b. Flex a b -> b
crossGap :: b,
    -- | The children to layout, 2D list so as to store lines once split.
    forall a b. Flex a b -> [[FlexChild a b]]
children :: [[FlexChild a b]],
    -- | How wide to consider the page when paginating.
    forall a b. Flex a b -> Double
pageWidth :: Double
} deriving (Flex a b -> Flex a b -> Bool
(Flex a b -> Flex a b -> Bool)
-> (Flex a b -> Flex a b -> Bool) -> Eq (Flex a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq b, Eq a) => Flex a b -> Flex a b -> Bool
$c== :: forall a b. (Eq b, Eq a) => Flex a b -> Flex a b -> Bool
== :: Flex a b -> Flex a b -> Bool
$c/= :: forall a b. (Eq b, Eq a) => Flex a b -> Flex a b -> Bool
/= :: Flex a b -> Flex a b -> Bool
Eq, Int -> Flex a b -> ShowS
[Flex a b] -> ShowS
Flex a b -> String
(Int -> Flex a b -> ShowS)
-> (Flex a b -> String) -> ([Flex a b] -> ShowS) -> Show (Flex a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Int -> Flex a b -> ShowS
forall a b. (Show b, Show a) => [Flex a b] -> ShowS
forall a b. (Show b, Show a) => Flex a b -> String
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> Flex a b -> ShowS
showsPrec :: Int -> Flex a b -> ShowS
$cshow :: forall a b. (Show b, Show a) => Flex a b -> String
show :: Flex a b -> String
$cshowList :: forall a b. (Show b, Show a) => [Flex a b] -> ShowS
showList :: [Flex a b] -> ShowS
Show, ReadPrec [Flex a b]
ReadPrec (Flex a b)
Int -> ReadS (Flex a b)
ReadS [Flex a b]
(Int -> ReadS (Flex a b))
-> ReadS [Flex a b]
-> ReadPrec (Flex a b)
-> ReadPrec [Flex a b]
-> Read (Flex a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read b, Read a) => ReadPrec [Flex a b]
forall a b. (Read b, Read a) => ReadPrec (Flex a b)
forall a b. (Read b, Read a) => Int -> ReadS (Flex a b)
forall a b. (Read b, Read a) => ReadS [Flex a b]
$creadsPrec :: forall a b. (Read b, Read a) => Int -> ReadS (Flex a b)
readsPrec :: Int -> ReadS (Flex a b)
$creadList :: forall a b. (Read b, Read a) => ReadS [Flex a b]
readList :: ReadS [Flex a b]
$creadPrec :: forall a b. (Read b, Read a) => ReadPrec (Flex a b)
readPrec :: ReadPrec (Flex a b)
$creadListPrec :: forall a b. (Read b, Read a) => ReadPrec [Flex a b]
readListPrec :: ReadPrec [Flex a b]
Read)
-- | Properties for positioning a child of a flexbox
data FlexChild a b = FlexChild {
    forall a b. FlexChild a b -> Double
grow :: Double,
    forall a b. FlexChild a b -> Double
shrink :: Double,
    forall a b. FlexChild a b -> b
basis :: b,
    forall a b. FlexChild a b -> Alignment
alignment :: Alignment,
    forall a b. FlexChild a b -> a
flexInner :: a
} deriving (FlexChild a b -> FlexChild a b -> Bool
(FlexChild a b -> FlexChild a b -> Bool)
-> (FlexChild a b -> FlexChild a b -> Bool) -> Eq (FlexChild a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq b, Eq a) => FlexChild a b -> FlexChild a b -> Bool
$c== :: forall a b. (Eq b, Eq a) => FlexChild a b -> FlexChild a b -> Bool
== :: FlexChild a b -> FlexChild a b -> Bool
$c/= :: forall a b. (Eq b, Eq a) => FlexChild a b -> FlexChild a b -> Bool
/= :: FlexChild a b -> FlexChild a b -> Bool
Eq, Int -> FlexChild a b -> ShowS
[FlexChild a b] -> ShowS
FlexChild a b -> String
(Int -> FlexChild a b -> ShowS)
-> (FlexChild a b -> String)
-> ([FlexChild a b] -> ShowS)
-> Show (FlexChild a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Int -> FlexChild a b -> ShowS
forall a b. (Show b, Show a) => [FlexChild a b] -> ShowS
forall a b. (Show b, Show a) => FlexChild a b -> String
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> FlexChild a b -> ShowS
showsPrec :: Int -> FlexChild a b -> ShowS
$cshow :: forall a b. (Show b, Show a) => FlexChild a b -> String
show :: FlexChild a b -> String
$cshowList :: forall a b. (Show b, Show a) => [FlexChild a b] -> ShowS
showList :: [FlexChild a b] -> ShowS
Show, ReadPrec [FlexChild a b]
ReadPrec (FlexChild a b)
Int -> ReadS (FlexChild a b)
ReadS [FlexChild a b]
(Int -> ReadS (FlexChild a b))
-> ReadS [FlexChild a b]
-> ReadPrec (FlexChild a b)
-> ReadPrec [FlexChild a b]
-> Read (FlexChild a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read b, Read a) => ReadPrec [FlexChild a b]
forall a b. (Read b, Read a) => ReadPrec (FlexChild a b)
forall a b. (Read b, Read a) => Int -> ReadS (FlexChild a b)
forall a b. (Read b, Read a) => ReadS [FlexChild a b]
$creadsPrec :: forall a b. (Read b, Read a) => Int -> ReadS (FlexChild a b)
readsPrec :: Int -> ReadS (FlexChild a b)
$creadList :: forall a b. (Read b, Read a) => ReadS [FlexChild a b]
readList :: ReadS [FlexChild a b]
$creadPrec :: forall a b. (Read b, Read a) => ReadPrec (FlexChild a b)
readPrec :: ReadPrec (FlexChild a b)
$creadListPrec :: forall a b. (Read b, Read a) => ReadPrec [FlexChild a b]
readListPrec :: ReadPrec [FlexChild a b]
Read)

-- | Which axis to position children along
data Direction = Row | Column deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Direction
readsPrec :: Int -> ReadS Direction
$creadList :: ReadS [Direction]
readList :: ReadS [Direction]
$creadPrec :: ReadPrec Direction
readPrec :: ReadPrec Direction
$creadListPrec :: ReadPrec [Direction]
readListPrec :: ReadPrec [Direction]
Read)
-- | Whether to wrap or reverse the wrapped lines
data FlexWrapping = NoWrap | Wrap | WrapReverse deriving (FlexWrapping -> FlexWrapping -> Bool
(FlexWrapping -> FlexWrapping -> Bool)
-> (FlexWrapping -> FlexWrapping -> Bool) -> Eq FlexWrapping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlexWrapping -> FlexWrapping -> Bool
== :: FlexWrapping -> FlexWrapping -> Bool
$c/= :: FlexWrapping -> FlexWrapping -> Bool
/= :: FlexWrapping -> FlexWrapping -> Bool
Eq, Int -> FlexWrapping -> ShowS
[FlexWrapping] -> ShowS
FlexWrapping -> String
(Int -> FlexWrapping -> ShowS)
-> (FlexWrapping -> String)
-> ([FlexWrapping] -> ShowS)
-> Show FlexWrapping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlexWrapping -> ShowS
showsPrec :: Int -> FlexWrapping -> ShowS
$cshow :: FlexWrapping -> String
show :: FlexWrapping -> String
$cshowList :: [FlexWrapping] -> ShowS
showList :: [FlexWrapping] -> ShowS
Show, ReadPrec [FlexWrapping]
ReadPrec FlexWrapping
Int -> ReadS FlexWrapping
ReadS [FlexWrapping]
(Int -> ReadS FlexWrapping)
-> ReadS [FlexWrapping]
-> ReadPrec FlexWrapping
-> ReadPrec [FlexWrapping]
-> Read FlexWrapping
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FlexWrapping
readsPrec :: Int -> ReadS FlexWrapping
$creadList :: ReadS [FlexWrapping]
readList :: ReadS [FlexWrapping]
$creadPrec :: ReadPrec FlexWrapping
readPrec :: ReadPrec FlexWrapping
$creadListPrec :: ReadPrec [FlexWrapping]
readListPrec :: ReadPrec [FlexWrapping]
Read)
-- | How to position lines within a flexbox, or children within a line
data Justification = JStart | JEnd | JCenter | JSpaceBetween | JSpaceAround | JSpaceEvenly
    deriving (Justification -> Justification -> Bool
(Justification -> Justification -> Bool)
-> (Justification -> Justification -> Bool) -> Eq Justification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Justification -> Justification -> Bool
== :: Justification -> Justification -> Bool
$c/= :: Justification -> Justification -> Bool
/= :: Justification -> Justification -> Bool
Eq, Int -> Justification -> ShowS
[Justification] -> ShowS
Justification -> String
(Int -> Justification -> ShowS)
-> (Justification -> String)
-> ([Justification] -> ShowS)
-> Show Justification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Justification -> ShowS
showsPrec :: Int -> Justification -> ShowS
$cshow :: Justification -> String
show :: Justification -> String
$cshowList :: [Justification] -> ShowS
showList :: [Justification] -> ShowS
Show, ReadPrec [Justification]
ReadPrec Justification
Int -> ReadS Justification
ReadS [Justification]
(Int -> ReadS Justification)
-> ReadS [Justification]
-> ReadPrec Justification
-> ReadPrec [Justification]
-> Read Justification
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Justification
readsPrec :: Int -> ReadS Justification
$creadList :: ReadS [Justification]
readList :: ReadS [Justification]
$creadPrec :: ReadPrec Justification
readPrec :: ReadPrec Justification
$creadListPrec :: ReadPrec [Justification]
readListPrec :: ReadPrec [Justification]
Read)
-- | How to align children along the cross-axis (opposite axis from which they're laid out)
data Alignment = AlStretch | AlStart | AlEnd | AlCenter | AlBaseline
    deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
/= :: Alignment -> Alignment -> Bool
Eq, Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alignment -> ShowS
showsPrec :: Int -> Alignment -> ShowS
$cshow :: Alignment -> String
show :: Alignment -> String
$cshowList :: [Alignment] -> ShowS
showList :: [Alignment] -> ShowS
Show, ReadPrec [Alignment]
ReadPrec Alignment
Int -> ReadS Alignment
ReadS [Alignment]
(Int -> ReadS Alignment)
-> ReadS [Alignment]
-> ReadPrec Alignment
-> ReadPrec [Alignment]
-> Read Alignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Alignment
readsPrec :: Int -> ReadS Alignment
$creadList :: ReadS [Alignment]
readList :: ReadS [Alignment]
$creadPrec :: ReadPrec Alignment
readPrec :: ReadPrec Alignment
$creadListPrec :: ReadPrec [Alignment]
readListPrec :: ReadPrec [Alignment]
Read)

-- | Apply an operation to every child
flexMap :: (a -> b) -> Flex a c -> Flex b c
flexMap :: forall a b c. (a -> b) -> Flex a c -> Flex b c
flexMap a -> b
cb Flex a c
self = Flex {
    direction :: Direction
direction = Flex a c -> Direction
forall a b. Flex a b -> Direction
direction Flex a c
self, reverseRows :: Bool
reverseRows = Flex a c -> Bool
forall a b. Flex a b -> Bool
reverseRows Flex a c
self, wrap :: FlexWrapping
wrap = Flex a c -> FlexWrapping
forall a b. Flex a b -> FlexWrapping
wrap Flex a c
self,
    justify :: Justification
justify = Flex a c -> Justification
forall a b. Flex a b -> Justification
justify Flex a c
self, alignLines :: Maybe Justification
alignLines = Flex a c -> Maybe Justification
forall a b. Flex a b -> Maybe Justification
alignLines Flex a c
self,
    baseGap :: c
baseGap = Flex a c -> c
forall a b. Flex a b -> b
baseGap Flex a c
self, crossGap :: c
crossGap = Flex a c -> c
forall a b. Flex a b -> b
crossGap Flex a c
self, pageWidth :: Double
pageWidth = Flex a c -> Double
forall a b. Flex a b -> Double
pageWidth Flex a c
self,
    children :: [[FlexChild b c]]
children = [[FlexChild {
        grow :: Double
grow = FlexChild a c -> Double
forall a b. FlexChild a b -> Double
grow FlexChild a c
kid, shrink :: Double
shrink = FlexChild a c -> Double
forall a b. FlexChild a b -> Double
shrink FlexChild a c
kid, basis :: c
basis = FlexChild a c -> c
forall a b. FlexChild a b -> b
basis FlexChild a c
kid,
        alignment :: Alignment
alignment = FlexChild a c -> Alignment
forall a b. FlexChild a b -> Alignment
alignment FlexChild a c
kid,
        flexInner :: b
flexInner = a -> b
cb (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ FlexChild a c -> a
forall a b. FlexChild a b -> a
flexInner FlexChild a c
kid -- The important line!
    } | FlexChild a c
kid <- [FlexChild a c]
row] | [FlexChild a c]
row <- Flex a c -> [[FlexChild a c]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a c
self]
  }
-- | Resolve lengths in the flexbox to doubles.
flexResolve :: CastDouble b => (a -> Direction -> Double) -> Double ->
        Flex a b -> Flex a Double
flexResolve :: forall b a.
CastDouble b =>
(a -> Direction -> Double) -> Double -> Flex a b -> Flex a Double
flexResolve a -> Direction -> Double
cb Double
size Flex a b
self = Flex {
    direction :: Direction
direction = Flex a b -> Direction
forall a b. Flex a b -> Direction
direction Flex a b
self, reverseRows :: Bool
reverseRows = Flex a b -> Bool
forall a b. Flex a b -> Bool
reverseRows Flex a b
self, wrap :: FlexWrapping
wrap = Flex a b -> FlexWrapping
forall a b. Flex a b -> FlexWrapping
wrap Flex a b
self,
    justify :: Justification
justify = Flex a b -> Justification
forall a b. Flex a b -> Justification
justify Flex a b
self, alignLines :: Maybe Justification
alignLines = Flex a b -> Maybe Justification
forall a b. Flex a b -> Maybe Justification
alignLines Flex a b
self,
    baseGap :: Double
baseGap = Double -> b -> Double
forall a. CastDouble a => Double -> a -> Double
toDoubleWithin Double
size (b -> Double) -> b -> Double
forall a b. (a -> b) -> a -> b
$ Flex a b -> b
forall a b. Flex a b -> b
baseGap Flex a b
self,
    crossGap :: Double
crossGap = Double -> b -> Double
forall a. CastDouble a => Double -> a -> Double
toDoubleWithin Double
size (b -> Double) -> b -> Double
forall a b. (a -> b) -> a -> b
$ Flex a b -> b
forall a b. Flex a b -> b
crossGap Flex a b
self,
    pageWidth :: Double
pageWidth = Flex a b -> Double
forall a b. Flex a b -> Double
pageWidth Flex a b
self,
    children :: [[FlexChild a Double]]
children = [[FlexChild {
        grow :: Double
grow = FlexChild a b -> Double
forall a b. FlexChild a b -> Double
grow FlexChild a b
kid, shrink :: Double
shrink = FlexChild a b -> Double
forall a b. FlexChild a b -> Double
shrink FlexChild a b
kid,
        basis :: Double
basis = Double -> Double -> b -> Double
forall a. CastDouble a => Double -> Double -> a -> Double
toDoubleWithinAuto (FlexChild a b -> a
forall a b. FlexChild a b -> a
flexInner FlexChild a b
kid a -> Direction -> Double
`cb` Flex a b -> Direction
forall a b. Flex a b -> Direction
direction Flex a b
self) Double
size (b -> Double) -> b -> Double
forall a b. (a -> b) -> a -> b
$ FlexChild a b -> b
forall a b. FlexChild a b -> b
basis FlexChild a b
kid,
        alignment :: Alignment
alignment = FlexChild a b -> Alignment
forall a b. FlexChild a b -> Alignment
alignment FlexChild a b
kid, flexInner :: a
flexInner = FlexChild a b -> a
forall a b. FlexChild a b -> a
flexInner FlexChild a b
kid
    } | FlexChild a b
kid <- [FlexChild a b]
row] | [FlexChild a b]
row <- Flex a b -> [[FlexChild a b]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a b
self]
  }

-- | The minimum size of the flexbox along `direction`, i.e. maximum size of a child.
flexMaxBasis :: Flex a Double -> Double
flexMaxBasis :: forall a. Flex a Double -> Double
flexMaxBasis Flex a Double
self = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [FlexChild a Double -> Double
forall a b. FlexChild a b -> b
basis FlexChild a Double
child | [FlexChild a Double]
row <- Flex a Double -> [[FlexChild a Double]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a Double
self, FlexChild a Double
child <- [FlexChild a Double]
row]
-- | The maximum width of each row of the flexbox.
flexSumBasis :: Flex a Double -> Double
flexSumBasis :: forall a. Flex a Double -> Double
flexSumBasis Flex a Double
self = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [[Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$
        Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
intersperse (Flex a Double -> Double
forall a b. Flex a b -> b
baseGap Flex a Double
self) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (FlexChild a Double -> Double) -> [FlexChild a Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map FlexChild a Double -> Double
forall a b. FlexChild a b -> b
basis [FlexChild a Double]
row | [FlexChild a Double]
row <- Flex a Double -> [[FlexChild a Double]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a Double
self]

-- | Wrap all lines to a given size reassigning overflow or underflow space.
-- NOTE: shrink propery may yield negative sizes. Caller will want to enforce min-sizes.
flexWrap :: CastDouble b => Flex a b -> Double -> Flex a b
flexWrap :: forall b a. CastDouble b => Flex a b -> Double -> Flex a b
flexWrap Flex a b
self Double
size
    | FlexWrapping
NoWrap <- Flex a b -> FlexWrapping
forall a b. Flex a b -> FlexWrapping
wrap Flex a b
self = Flex a b -> Flex a b
forall b a. CastDouble b => Flex a b -> Flex a b
post Flex a b
self
    | FlexWrapping
Wrap <- Flex a b -> FlexWrapping
forall a b. Flex a b -> FlexWrapping
wrap Flex a b
self = Flex a b -> Flex a b
forall b a. CastDouble b => Flex a b -> Flex a b
post Flex a b
self'
    | FlexWrapping
WrapReverse <- Flex a b -> FlexWrapping
forall a b. Flex a b -> FlexWrapping
wrap Flex a b
self = Flex a b -> Flex a b
forall b a. CastDouble b => Flex a b -> Flex a b
post Flex a b
self' { children :: [[FlexChild a b]]
children=[[FlexChild a b]] -> [[FlexChild a b]]
forall a. [a] -> [a]
reverse ([[FlexChild a b]] -> [[FlexChild a b]])
-> [[FlexChild a b]] -> [[FlexChild a b]]
forall a b. (a -> b) -> a -> b
$ Flex a b -> [[FlexChild a b]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a b
self' }
  where
    self' :: Flex a b
self' = Flex a b
self {
        children :: [[FlexChild a b]]
children = ([FlexChild a b] -> [[FlexChild a b]])
-> [[FlexChild a b]] -> [[FlexChild a b]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [FlexChild a b] -> [[FlexChild a b]]
forall b a. CastDouble b => [FlexChild a b] -> [[FlexChild a b]]
wrapRow ([[FlexChild a b]] -> [[FlexChild a b]])
-> [[FlexChild a b]] -> [[FlexChild a b]]
forall a b. (a -> b) -> a -> b
$ Flex a b -> [[FlexChild a b]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a b
self
    }
    wrapRow :: CastDouble b => [FlexChild a b] -> [[FlexChild a b]]
    wrapRow :: forall b a. CastDouble b => [FlexChild a b] -> [[FlexChild a b]]
wrapRow [] = []
    wrapRow kids :: [FlexChild a b]
kids@(FlexChild a b
kid:[FlexChild a b]
_) = let ([FlexChild a b]
row, [FlexChild a b]
rest) = [FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
forall b a.
CastDouble b =>
[FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
splitRow' [FlexChild a b]
kids (Double -> ([FlexChild a b], [FlexChild a b]))
-> Double -> ([FlexChild a b], [FlexChild a b])
forall a b. (a -> b) -> a -> b
$ FlexChild a b -> Double
forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid
        in [FlexChild a b]
row[FlexChild a b] -> [[FlexChild a b]] -> [[FlexChild a b]]
forall a. a -> [a] -> [a]
:[FlexChild a b] -> [[FlexChild a b]]
forall b a. CastDouble b => [FlexChild a b] -> [[FlexChild a b]]
wrapRow [FlexChild a b]
rest
    splitRow, splitRow' :: CastDouble b => [FlexChild a b] -> Double ->
            ([FlexChild a b], [FlexChild a b])
    -- This wrapper function ensures we don't end up with empty rows, or infinite loops.
    splitRow' :: forall b a.
CastDouble b =>
[FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
splitRow' (FlexChild a b
kid:[FlexChild a b]
kids) Double
end =
        let ([FlexChild a b]
kids', [FlexChild a b]
rest) = [FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
forall b a.
CastDouble b =>
[FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
splitRow [FlexChild a b]
kids (Double
end Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Flex a b -> Double
forall b a. CastDouble b => Flex a b -> Double
baseGap' Flex a b
self Double -> Double -> Double
forall a. Num a => a -> a -> a
+ FlexChild a b -> Double
forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid)
        in (FlexChild a b
kidFlexChild a b -> [FlexChild a b] -> [FlexChild a b]
forall a. a -> [a] -> [a]
:[FlexChild a b]
kids', [FlexChild a b]
rest)
    splitRow' [] Double
_ = ([], [])
    splitRow :: forall b a.
CastDouble b =>
[FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
splitRow (FlexChild a b
kid:[FlexChild a b]
kids) Double
end
        | Double
end Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
size = ([], FlexChild a b
kidFlexChild a b -> [FlexChild a b] -> [FlexChild a b]
forall a. a -> [a] -> [a]
:[FlexChild a b]
kids)
        | Bool
otherwise = let ([FlexChild a b]
kids', [FlexChild a b]
rest) = [FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
forall b a.
CastDouble b =>
[FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
splitRow [FlexChild a b]
kids (Double
end Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Flex a b -> Double
forall b a. CastDouble b => Flex a b -> Double
baseGap' Flex a b
self Double -> Double -> Double
forall a. Num a => a -> a -> a
+ FlexChild a b -> Double
forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid)
            in (FlexChild a b
kidFlexChild a b -> [FlexChild a b] -> [FlexChild a b]
forall a. a -> [a] -> [a]
:[FlexChild a b]
kids', [FlexChild a b]
rest)
    splitRow [] Double
_ = ([], [])

    post :: CastDouble b => Flex a b -> Flex a b
    post :: forall b a. CastDouble b => Flex a b -> Flex a b
post Flex a b
flex
        | Flex a b -> Bool
forall a b. Flex a b -> Bool
reverseRows Flex a b
self = Flex a b -> Flex a b
forall b a. CastDouble b => Flex a b -> Flex a b
post' Flex a b
flex { children :: [[FlexChild a b]]
children = ([FlexChild a b] -> [FlexChild a b])
-> [[FlexChild a b]] -> [[FlexChild a b]]
forall a b. (a -> b) -> [a] -> [b]
map [FlexChild a b] -> [FlexChild a b]
forall a. [a] -> [a]
reverse ([[FlexChild a b]] -> [[FlexChild a b]])
-> [[FlexChild a b]] -> [[FlexChild a b]]
forall a b. (a -> b) -> a -> b
$ Flex a b -> [[FlexChild a b]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a b
flex }
        | Bool
otherwise = Flex a b -> Flex a b
forall b a. CastDouble b => Flex a b -> Flex a b
post' Flex a b
flex
    post' :: CastDouble b => Flex a b -> Flex a b
    post' :: forall b a. CastDouble b => Flex a b -> Flex a b
post' Flex a b
flex = Flex a b
flex { children :: [[FlexChild a b]]
children = ([FlexChild a b] -> [FlexChild a b])
-> [[FlexChild a b]] -> [[FlexChild a b]]
forall a b. (a -> b) -> [a] -> [b]
map [FlexChild a b] -> [FlexChild a b]
forall b a. CastDouble b => [FlexChild a b] -> [FlexChild a b]
resizeRow ([[FlexChild a b]] -> [[FlexChild a b]])
-> [[FlexChild a b]] -> [[FlexChild a b]]
forall a b. (a -> b) -> a -> b
$ Flex a b -> [[FlexChild a b]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a b
flex }
    resizeRow :: CastDouble b => [FlexChild a b] -> [FlexChild a b]
    resizeRow :: forall b a. CastDouble b => [FlexChild a b] -> [FlexChild a b]
resizeRow [FlexChild a b]
row
        | Double
rowSize Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
size = [FlexChild a b
kid {
                basis :: b
basis = Double -> b
forall a. CastDouble a => Double -> a
fromDouble (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ FlexChild a b -> Double
forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid Double -> Double -> Double
forall a. Num a => a -> a -> a
- FlexChild a b -> Double
forall a b. FlexChild a b -> Double
shrink FlexChild a b
kid Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall {a}. RealFloat a => a -> a
nanguard Double
sfr
            } | FlexChild a b
kid <- [FlexChild a b]
row]
        | Double
rowSize Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
size = [FlexChild a b
kid {
                basis :: b
basis = Double -> b
forall a. CastDouble a => Double -> a
fromDouble (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ FlexChild a b -> Double
forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid Double -> Double -> Double
forall a. Num a => a -> a -> a
+ FlexChild a b -> Double
forall a b. FlexChild a b -> Double
grow FlexChild a b
kid Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall {a}. RealFloat a => a -> a
nanguard Double
gfr
            } | FlexChild a b
kid <- [FlexChild a b]
row]
        | Bool
otherwise = [FlexChild a b]
row
      where
        rowSize :: Double
rowSize = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
intersperse (Flex a b -> Double
forall b a. CastDouble b => Flex a b -> Double
baseGap' Flex a b
self) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (FlexChild a b -> Double) -> [FlexChild a b] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map FlexChild a b -> Double
forall b a. CastDouble b => FlexChild a b -> Double
basis' [FlexChild a b]
row
        sfr :: Double
sfr = (Double
rowSize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
size)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/([Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (FlexChild a b -> Double) -> [FlexChild a b] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map FlexChild a b -> Double
forall a b. FlexChild a b -> Double
shrink [FlexChild a b]
row)
        gfr :: Double
gfr = (Double
size Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rowSize)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/([Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (FlexChild a b -> Double) -> [FlexChild a b] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map FlexChild a b -> Double
forall a b. FlexChild a b -> Double
grow [FlexChild a b]
row)
        nanguard :: a -> a
nanguard a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = a
0
            | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = a
0
            | Bool
otherwise = a
x
    baseGap' :: CastDouble b => Flex a b -> Double
    baseGap' :: forall b a. CastDouble b => Flex a b -> Double
baseGap' = b -> Double
forall a. CastDouble a => a -> Double
toDouble (b -> Double) -> (Flex a b -> b) -> Flex a b -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flex a b -> b
forall a b. Flex a b -> b
baseGap
    basis' :: CastDouble b => FlexChild a b -> Double
    basis' :: forall b a. CastDouble b => FlexChild a b -> Double
basis' = b -> Double
forall a. CastDouble a => a -> Double
toDouble (b -> Double) -> (FlexChild a b -> b) -> FlexChild a b -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlexChild a b -> b
forall a b. FlexChild a b -> b
basis

-- | The cross (opposite from `direction` axis) size of a row.
flexRowSize :: (a -> Double) -> [FlexChild a b] -> Double
flexRowSize :: forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize a -> Double
cb [FlexChild a b]
row = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (FlexChild a b -> Double) -> [FlexChild a b] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Double
cb (a -> Double) -> (FlexChild a b -> a) -> FlexChild a b -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlexChild a b -> a
forall a b. FlexChild a b -> a
flexInner) [FlexChild a b]
row
-- | The cross (opposite from `direction` axis) size of all rows.
flexRowsSize :: (a -> Double) -> Flex a Double -> Double
flexRowsSize :: forall a. (a -> Double) -> Flex a Double -> Double
flexRowsSize a -> Double
cb Flex { crossGap :: forall a b. Flex a b -> b
crossGap = Double
gap, children :: forall a b. Flex a b -> [[FlexChild a b]]
children = [[FlexChild a Double]]
kids } =
    [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
intersperse Double
gap ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (a -> Double) -> [FlexChild a Double] -> Double
forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize a -> Double
cb ([FlexChild a Double] -> Double)
-> [[FlexChild a Double]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
`map` [[FlexChild a Double]]
kids

justifyOffset, justifySpacing :: Double -> [Double] -> Double -> Justification -> Double
-- | How far right to shift some elements to achieve desired justification.
justifyOffset :: Double -> [Double] -> Double -> Justification -> Double
justifyOffset Double
_ [Double]
_ Double
_ Justification
JStart = Double
0
justifyOffset Double
outersize [Double]
ks Double
g Justification
JEnd = Double
outersize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> [Double] -> Double
forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks
justifyOffset Double
outersize [Double]
ks Double
g Justification
JCenter = Double -> Double
half (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
outersize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> [Double] -> Double
forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks
justifyOffset Double
_ [Double]
_ Double
_ Justification
JSpaceBetween = Double
0
justifyOffset Double
outersize [Double]
ks Double
g Justification
JSpaceAround =
    Double -> Double
half (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Double
outersize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> [Double] -> Double
forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/[Double] -> Double
forall a. [a] -> Double
length' [Double]
ks
justifyOffset Double
_ [Double]
ks Double
_ Justification
_ | [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Double
0 -- No gaps to space, avoid numeric errors.
justifyOffset Double
size [Double]
ks Double
g Justification
JSpaceEvenly = (Double
size Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> [Double] -> Double
forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/([Double] -> Double
forall a. [a] -> Double
length' [Double]
ks Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1)
-- | How much space to add between elements.
justifySpacing :: Double -> [Double] -> Double -> Justification -> Double
justifySpacing Double
size [Double]
ks Double
g Justification
JSpaceBetween = (Double
size Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> [Double] -> Double
forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/([Double] -> Double
forall a. [a] -> Double
length' [Double]
ks Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)
justifySpacing Double
size [Double]
ks Double
g Justification
JSpaceAround = (Double
size Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> [Double] -> Double
forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/[Double] -> Double
forall a. [a] -> Double
length' [Double]
ks
justifySpacing Double
size [Double]
ks Double
g Justification
JSpaceEvenly = (Double
size Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> [Double] -> Double
forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/([Double] -> Double
forall a. [a] -> Double
length' [Double]
ks Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1)
justifySpacing Double
_ [Double]
_ Double
_ Justification
_ = Double
0

-- | Position new positions for the given items according to the given justification.
flexJustify :: (a -> Double) -> Double -> [a] -> Double -> Justification -> [(Double, a)]
flexJustify :: forall a.
(a -> Double)
-> Double -> [a] -> Double -> Justification -> [(Double, a)]
flexJustify a -> Double
cb Double
size [a]
kids Double
gap Justification
just = [a] -> Double -> [(Double, a)]
inner [a]
kids Double
offs
  where
    offs :: Double
offs = Double -> [Double] -> Double -> Justification -> Double
justifyOffset Double
size [Double]
kids' Double
gap Justification
just
    spacing :: Double
spacing = Double -> [Double] -> Double -> Justification -> Double
justifySpacing Double
size [Double]
kids' Double
gap Justification
just
    kids' :: [Double]
kids' = (a -> Double) -> [a] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map a -> Double
cb [a]
kids
    inner :: [a] -> Double -> [(Double, a)]
inner (a
k:[a]
ks) Double
start = (Double
start, a
k)(Double, a) -> [(Double, a)] -> [(Double, a)]
forall a. a -> [a] -> [a]
:[a] -> Double -> [(Double, a)]
inner [a]
ks (Double
start Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
cb a
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gap)
    inner [] Double
_ = []

-- | How far right to shift some elements to achieve desired alignment.
alignOffset :: Double -> Double -> Alignment -> Double
alignOffset :: Double -> Double -> Alignment -> Double
alignOffset Double
_ Double
_ Alignment
AlStretch = Double
0 -- Needs special handling elsewhere
alignOffset Double
_ Double
_ Alignment
AlStart = Double
0
alignOffset Double
outer Double
inner Alignment
AlEnd = Double
outer Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
inner
alignOffset Double
outer Double
inner Alignment
AlCenter = Double -> Double
half (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
outer Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
inner
alignOffset Double
outer Double
inner Alignment
AlBaseline = Double -> Double
half (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
outer Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
inner -- FIXME: Implement properly!

-- | Sum given sizes with a specified gap between them.
innersize :: c -> [c] -> c
innersize c
gap = [c] -> c
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([c] -> c) -> ([c] -> [c]) -> [c] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [c] -> [c]
forall a. a -> [a] -> [a]
intersperse c
gap
-- | divide by 2, can be syntactically in certain circumstances.
half :: Double -> Double
half = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
-- | length of an list, as a double.
length' :: [a] -> Double
length' :: forall a. [a] -> Double
length' = Int -> Double
forall a. Enum a => Int -> a
toEnum (Int -> Double) -> ([a] -> Int) -> [a] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

------
--- Mapping Box Model axes <-> Flex Box axes
------

outerMinMain, outerMain, outerMaxMain :: Num m => PaddedBox m m -> Direction -> m
outerMinMain :: forall m. Num m => PaddedBox m m -> Direction -> m
outerMinMain PaddedBox m m
box Direction
Row = PaddedBox m m -> m
forall {a} {m}. Num a => PaddedBox m a -> a
minWidth PaddedBox m m
box
outerMinMain PaddedBox m m
box Direction
Column = PaddedBox m m -> m
forall {a} {n}. Num a => PaddedBox a n -> a
minHeight PaddedBox m m
box
outerMain :: forall m. Num m => PaddedBox m m -> Direction -> m
outerMain PaddedBox m m
box Direction
Row = PaddedBox m m -> m
forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox m m
box
outerMain PaddedBox m m
box Direction
Column = PaddedBox m m -> m
forall {a} {n}. Num a => PaddedBox a n -> a
height PaddedBox m m
box
outerMaxMain :: forall m. Num m => PaddedBox m m -> Direction -> m
outerMaxMain PaddedBox m m
box Direction
Row = PaddedBox m m -> m
forall {a} {m}. Num a => PaddedBox m a -> a
maxWidth PaddedBox m m
box
outerMaxMain PaddedBox m m
box Direction
Column = PaddedBox m m -> m
forall {a} {n}. Num a => PaddedBox a n -> a
maxHeight PaddedBox m m
box

outerMinCross, outerCross, outerMaxCross :: Num m => PaddedBox m m -> Direction -> m
outerMinCross :: forall m. Num m => PaddedBox m m -> Direction -> m
outerMinCross PaddedBox m m
box Direction
Row = PaddedBox m m -> m
forall {a} {n}. Num a => PaddedBox a n -> a
minHeight PaddedBox m m
box
outerMinCross PaddedBox m m
box Direction
Column = PaddedBox m m -> m
forall {a} {m}. Num a => PaddedBox m a -> a
minWidth PaddedBox m m
box
outerCross :: forall m. Num m => PaddedBox m m -> Direction -> m
outerCross PaddedBox m m
box Direction
Row = PaddedBox m m -> m
forall {a} {n}. Num a => PaddedBox a n -> a
height PaddedBox m m
box
outerCross PaddedBox m m
box Direction
Column = PaddedBox m m -> m
forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox m m
box
outerMaxCross :: forall m. Num m => PaddedBox m m -> Direction -> m
outerMaxCross PaddedBox m m
box Direction
Row = PaddedBox m m -> m
forall {a} {n}. Num a => PaddedBox a n -> a
maxHeight PaddedBox m m
box
outerMaxCross PaddedBox m m
box Direction
Column = PaddedBox m m -> m
forall {a} {m}. Num a => PaddedBox m a -> a
maxWidth PaddedBox m m
box

innerMinMain, innerMain, innerMaxMain :: Num m => PaddedBox m m -> Direction -> m
innerMinMain :: forall m. Num m => PaddedBox m m -> Direction -> m
innerMinMain PaddedBox m m
box = Size m m -> Direction -> m
forall m. Num m => Size m m -> Direction -> m
sizeMain (Size m m -> Direction -> m) -> Size m m -> Direction -> m
forall a b. (a -> b) -> a -> b
$ PaddedBox m m -> Size m m
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox m m
box
innerMain :: forall m. Num m => PaddedBox m m -> Direction -> m
innerMain PaddedBox m m
box = Size m m -> Direction -> m
forall m. Num m => Size m m -> Direction -> m
sizeMain (Size m m -> Direction -> m) -> Size m m -> Direction -> m
forall a b. (a -> b) -> a -> b
$ PaddedBox m m -> Size m m
forall m n. PaddedBox m n -> Size m n
B.size PaddedBox m m
box
innerMaxMain :: forall m. Num m => PaddedBox m m -> Direction -> m
innerMaxMain PaddedBox m m
box = Size m m -> Direction -> m
forall m. Num m => Size m m -> Direction -> m
sizeMain (Size m m -> Direction -> m) -> Size m m -> Direction -> m
forall a b. (a -> b) -> a -> b
$ PaddedBox m m -> Size m m
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox m m
box

innerMinCross, innerCross, innerMaxCross :: Num m => PaddedBox m m -> Direction -> m
innerMinCross :: forall m. Num m => PaddedBox m m -> Direction -> m
innerMinCross PaddedBox m m
box = Size m m -> Direction -> m
forall m. Num m => Size m m -> Direction -> m
sizeCross (Size m m -> Direction -> m) -> Size m m -> Direction -> m
forall a b. (a -> b) -> a -> b
$ PaddedBox m m -> Size m m
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox m m
box
innerCross :: forall m. Num m => PaddedBox m m -> Direction -> m
innerCross PaddedBox m m
box = Size m m -> Direction -> m
forall m. Num m => Size m m -> Direction -> m
sizeCross (Size m m -> Direction -> m) -> Size m m -> Direction -> m
forall a b. (a -> b) -> a -> b
$ PaddedBox m m -> Size m m
forall m n. PaddedBox m n -> Size m n
B.size PaddedBox m m
box
innerMaxCross :: forall m. Num m => PaddedBox m m -> Direction -> m
innerMaxCross PaddedBox m m
box = Size m m -> Direction -> m
forall m. Num m => Size m m -> Direction -> m
sizeCross (Size m m -> Direction -> m) -> Size m m -> Direction -> m
forall a b. (a -> b) -> a -> b
$ PaddedBox m m -> Size m m
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox m m
box

sizeMain, sizeCross :: Num m => Size m m -> Direction -> m
sizeMain :: forall m. Num m => Size m m -> Direction -> m
sizeMain Size m m
self Direction
Row = Size m m -> m
forall m n. Size m n -> n
inline Size m m
self
sizeMain Size m m
self Direction
Column = Size m m -> m
forall m n. Size m n -> m
block Size m m
self
sizeCross :: forall m. Num m => Size m m -> Direction -> m
sizeCross Size m m
self Direction
Row = Size m m -> m
forall m n. Size m n -> m
block Size m m
self
sizeCross Size m m
self Direction
Column = Size m m -> m
forall m n. Size m n -> n
inline Size m m
self

-- | Compute the size bounds of a flexbox.
flexGetBox :: (Zero m, CastDouble m, Zero n, CastDouble n) =>
    (a -> PaddedBox Double Double) -> Flex a m -> PaddedBox m n
flexGetBox :: forall m n a.
(Zero m, CastDouble m, Zero n, CastDouble n) =>
(a -> PaddedBox Double Double) -> Flex a m -> PaddedBox m n
flexGetBox a -> PaddedBox Double Double
cb Flex a m
self = PaddedBox m n
forall a. Zero a => a
zero {
    min :: Size m n
B.min = Flex a Double -> Double
forall a. Flex a Double -> Double
flexMaxBasis Flex a Double
self' Double -> Double -> Size m n
forall {n} {m}.
(CastDouble n, CastDouble m) =>
Double -> Double -> Size m n
`size` (a -> Double) -> Flex a Double -> Double
forall a. (a -> Double) -> Flex a Double -> Double
flexRowsSize ((PaddedBox Double Double -> Direction -> Double) -> a -> Double
forall {c}. (PaddedBox Double Double -> Direction -> c) -> a -> c
cb' PaddedBox Double Double -> Direction -> Double
forall m. Num m => PaddedBox m m -> Direction -> m
innerMinCross) Flex a Double
self',
    max :: Size m n
B.max = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
infinity Double -> Double -> Size m n
forall {n} {m}.
(CastDouble n, CastDouble m) =>
Double -> Double -> Size m n
`size` Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
infinity,
    nat :: Size Double Double
B.nat = Flex a Double -> Double
forall a. Flex a Double -> Double
flexSumBasis Flex a Double
self' Double -> Double -> Size Double Double
forall {n} {m}.
(CastDouble n, CastDouble m) =>
Double -> Double -> Size m n
`size` (a -> Double) -> Flex a Double -> Double
forall a. (a -> Double) -> Flex a Double -> Double
flexRowsSize ((PaddedBox Double Double -> Direction -> Double) -> a -> Double
forall {c}. (PaddedBox Double Double -> Direction -> c) -> a -> c
cb' PaddedBox Double Double -> Direction -> Double
forall m. Num m => PaddedBox m m -> Direction -> m
innerCross) Flex a Double
self',
    size :: Size m n
B.size = Flex a Double -> Double
forall a. Flex a Double -> Double
flexSumBasis Flex a Double
self' Double -> Double -> Size m n
forall {n} {m}.
(CastDouble n, CastDouble m) =>
Double -> Double -> Size m n
`size` (a -> Double) -> Flex a Double -> Double
forall a. (a -> Double) -> Flex a Double -> Double
flexRowsSize ((PaddedBox Double Double -> Direction -> Double) -> a -> Double
forall {c}. (PaddedBox Double Double -> Direction -> c) -> a -> c
cb' PaddedBox Double Double -> Direction -> Double
forall m. Num m => PaddedBox m m -> Direction -> m
innerCross) Flex a Double
self'
  } where
    size :: Double -> Double -> Size m n
size Double
main Double
cross
        | Direction
Row <- Flex a m -> Direction
forall a b. Flex a b -> Direction
direction Flex a m
self = Double -> n
forall a. CastDouble a => Double -> a
fromDouble Double
main n -> m -> Size m n
forall m n. n -> m -> Size m n
`Size` Double -> m
forall a. CastDouble a => Double -> a
fromDouble Double
cross
        | Bool
otherwise = Double -> n
forall a. CastDouble a => Double -> a
fromDouble Double
cross n -> m -> Size m n
forall m n. n -> m -> Size m n
`Size` Double -> m
forall a. CastDouble a => Double -> a
fromDouble Double
main
    cb' :: (PaddedBox Double Double -> Direction -> c) -> a -> c
cb' PaddedBox Double Double -> Direction -> c
cb_ = (PaddedBox Double Double -> Direction -> c)
-> Direction -> PaddedBox Double Double -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip PaddedBox Double Double -> Direction -> c
cb_ (Flex a m -> Direction
forall a b. Flex a b -> Direction
direction Flex a m
self) (PaddedBox Double Double -> c)
-> (a -> PaddedBox Double Double) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PaddedBox Double Double
cb
    self' :: Flex a Double
self' = (a -> Direction -> Double) -> Double -> Flex a m -> Flex a Double
forall b a.
CastDouble b =>
(a -> Direction -> Double) -> Double -> Flex a b -> Flex a Double
flexResolve (PaddedBox Double Double -> Direction -> Double
forall m. Num m => PaddedBox m m -> Direction -> m
innerMain (PaddedBox Double Double -> Direction -> Double)
-> (a -> PaddedBox Double Double) -> a -> Direction -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PaddedBox Double Double
cb) Double
0 Flex a m
self

-- | Split a flexbox over multiple pages.
flexSplit :: (a -> Size Double Double) -> Double -> Double -> Flex a Double ->
    (Flex a Double, Flex a Double)
flexSplit :: forall a.
(a -> Size Double Double)
-> Double
-> Double
-> Flex a Double
-> (Flex a Double, Flex a Double)
flexSplit a -> Size Double Double
cb Double
h Double
_ self :: Flex a Double
self@Flex { direction :: forall a b. Flex a b -> Direction
direction = Direction
Row, pageWidth :: forall a b. Flex a b -> Double
pageWidth = Double
w } =
    (Flex a Double
self' { children :: [[FlexChild a Double]]
children = [[FlexChild a Double]]
page0 }, Flex a Double
self' { children :: [[FlexChild a Double]]
children = [[FlexChild a Double]]
page1 })
  where
    self' :: Flex a Double
self' = Flex a Double -> Double -> Flex a Double
forall b a. CastDouble b => Flex a b -> Double -> Flex a b
flexWrap Flex a Double
self Double
w
    ([[FlexChild a Double]]
page0, [[FlexChild a Double]]
page1) = Double
-> [[FlexChild a Double]]
-> ([[FlexChild a Double]], [[FlexChild a Double]])
forall {b}.
Double
-> [[FlexChild a b]] -> ([[FlexChild a b]], [[FlexChild a b]])
splitRows (-Flex a Double -> Double
forall a b. Flex a b -> b
crossGap Flex a Double
self) ([[FlexChild a Double]]
 -> ([[FlexChild a Double]], [[FlexChild a Double]]))
-> [[FlexChild a Double]]
-> ([[FlexChild a Double]], [[FlexChild a Double]])
forall a b. (a -> b) -> a -> b
$ Flex a Double -> [[FlexChild a Double]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a Double
self
    splitRows :: Double
-> [[FlexChild a b]] -> ([[FlexChild a b]], [[FlexChild a b]])
splitRows Double
start ([FlexChild a b]
row:[[FlexChild a b]]
rows)
        | Double
start Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
h = ([], [FlexChild a b]
row[FlexChild a b] -> [[FlexChild a b]] -> [[FlexChild a b]]
forall a. a -> [a] -> [a]
:[[FlexChild a b]]
rows)
        | Bool
otherwise =
            let ([[FlexChild a b]]
rows', [[FlexChild a b]]
rest) = (Double
 -> [[FlexChild a b]] -> ([[FlexChild a b]], [[FlexChild a b]]))
-> [[FlexChild a b]]
-> Double
-> ([[FlexChild a b]], [[FlexChild a b]])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double
-> [[FlexChild a b]] -> ([[FlexChild a b]], [[FlexChild a b]])
splitRows [[FlexChild a b]]
rows (Double -> ([[FlexChild a b]], [[FlexChild a b]]))
-> Double -> ([[FlexChild a b]], [[FlexChild a b]])
forall a b. (a -> b) -> a -> b
$
                    Double
start Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Flex a Double -> Double
forall a b. Flex a b -> b
crossGap Flex a Double
self Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (a -> Double) -> [FlexChild a b] -> Double
forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize (Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double)
-> (a -> Size Double Double) -> a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Size Double Double
cb) [FlexChild a b]
row
            in ([FlexChild a b]
row[FlexChild a b] -> [[FlexChild a b]] -> [[FlexChild a b]]
forall a. a -> [a] -> [a]
:[[FlexChild a b]]
rows', [[FlexChild a b]]
rest)
    splitRows Double
_ [] = ([], [])
flexSplit a -> Size Double Double
cb Double
h Double
h' self :: Flex a Double
self@Flex { direction :: forall a b. Flex a b -> Direction
direction = Direction
Column, pageWidth :: forall a b. Flex a b -> Double
pageWidth = Double
w }
    | Double -> Bool
measure Double
h = (Flex a Double -> Double -> Flex a Double
forall b a. CastDouble b => Flex a b -> Double -> Flex a b
flexWrap Flex a Double
self Double
h, Flex a Double
self { children :: [[FlexChild a Double]]
children = [] })
    -- If it fits on neither page... Row-direction is more versatile!
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Double -> Bool
measure Double
h' = (a -> Size Double Double)
-> Double
-> Double
-> Flex a Double
-> (Flex a Double, Flex a Double)
forall a.
(a -> Size Double Double)
-> Double
-> Double
-> Flex a Double
-> (Flex a Double, Flex a Double)
flexSplit a -> Size Double Double
cb Double
h Double
h' Flex a Double
self { direction :: Direction
direction = Direction
Row }
    | Bool
otherwise = (Flex a Double
self { children :: [[FlexChild a Double]]
children = [] }, Flex a Double -> Double -> Flex a Double
forall b a. CastDouble b => Flex a b -> Double -> Flex a b
flexWrap Flex a Double
self Double
h')
  where
    measure :: Double -> Bool
measure Double
space = (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double)
-> (a -> Size Double Double) -> a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Size Double Double
cb) (a -> Double) -> Flex a Double -> Double
forall a. (a -> Double) -> Flex a Double -> Double
`flexRowsSize` Flex a Double -> Double -> Flex a Double
forall b a. CastDouble b => Flex a b -> Double -> Flex a b
flexWrap Flex a Double
self Double
space Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
w

-- | Compute final position of a flexbox's children.
flexPosition :: ((Double, Double) -> a -> b) -> (a -> Size Double Double) ->
        (Double, Double) -> Size Double Double ->
        Flex a Double -> Flex b Double
flexPosition :: forall a b.
((Double, Double) -> a -> b)
-> (a -> Size Double Double)
-> (Double, Double)
-> Size Double Double
-> Flex a Double
-> Flex b Double
flexPosition (Double, Double) -> a -> b
cb a -> Size Double Double
cb' (Double
x,Double
y) Size Double Double
size self :: Flex a Double
self@Flex { direction :: forall a b. Flex a b -> Direction
direction = Direction
dir } = Flex a Double
self {
    children :: [[FlexChild b Double]]
children = ((Double, [FlexChild a Double]) -> [FlexChild b Double])
-> [(Double, [FlexChild a Double])] -> [[FlexChild b Double]]
forall a b. (a -> b) -> [a] -> [b]
map (Double, [FlexChild a Double]) -> [FlexChild b Double]
rowPosition ([(Double, [FlexChild a Double])] -> [[FlexChild b Double]])
-> [(Double, [FlexChild a Double])] -> [[FlexChild b Double]]
forall a b. (a -> b) -> a -> b
$ ([FlexChild a Double] -> Double)
-> Double
-> [[FlexChild a Double]]
-> Double
-> Justification
-> [(Double, [FlexChild a Double])]
forall a.
(a -> Double)
-> Double -> [a] -> Double -> Justification -> [(Double, a)]
flexJustify [FlexChild a Double] -> Double
forall {b}. [FlexChild a b] -> Double
rowsize (Size Double Double -> Direction -> Double
forall m. Num m => Size m m -> Direction -> m
sizeCross Size Double Double
size Direction
dir)
            (Flex a Double -> [[FlexChild a Double]]
forall a b. Flex a b -> [[FlexChild a b]]
children Flex a Double
self) (Flex a Double -> Double
forall a b. Flex a b -> b
crossGap Flex a Double
self) (Flex a Double -> Justification
forall a b. Flex a b -> Justification
justify Flex a Double
self)
  } where
    rowsize :: [FlexChild a b] -> Double
rowsize = (a -> Double) -> [FlexChild a b] -> Double
forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize ((a -> Double) -> [FlexChild a b] -> Double)
-> (a -> Double) -> [FlexChild a b] -> Double
forall a b. (a -> b) -> a -> b
$ (Size Double Double -> Direction -> Double)
-> Direction -> Size Double Double -> Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip Size Double Double -> Direction -> Double
forall m. Num m => Size m m -> Direction -> m
sizeCross Direction
dir (Size Double Double -> Double)
-> (a -> Size Double Double) -> a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Size Double Double
cb'
    -- TODO: Handle stretch properly
    rowPosition :: (Double, [FlexChild a Double]) -> [FlexChild b Double]
rowPosition (Double
rpos, [FlexChild a Double]
row) =
        let rsize :: Double
rsize = (a -> Double) -> [FlexChild a Double] -> Double
forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize ((Size Double Double -> Direction -> Double)
-> Direction -> Size Double Double -> Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip Size Double Double -> Direction -> Double
forall m. Num m => Size m m -> Direction -> m
sizeCross Direction
dir (Size Double Double -> Double)
-> (a -> Size Double Double) -> a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Size Double Double
cb') [FlexChild a Double]
row
        in ((Double, FlexChild a Double) -> FlexChild b Double)
-> [(Double, FlexChild a Double)] -> [FlexChild b Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double
-> Double -> (Double, FlexChild a Double) -> FlexChild b Double
forall {b}.
Double -> Double -> (Double, FlexChild a b) -> FlexChild b b
alignChild Double
rsize Double
rpos) ([(Double, FlexChild a Double)] -> [FlexChild b Double])
-> [(Double, FlexChild a Double)] -> [FlexChild b Double]
forall a b. (a -> b) -> a -> b
$ (FlexChild a Double -> Double)
-> Double
-> [FlexChild a Double]
-> Double
-> Justification
-> [(Double, FlexChild a Double)]
forall a.
(a -> Double)
-> Double -> [a] -> Double -> Justification -> [(Double, a)]
flexJustify FlexChild a Double -> Double
forall a b. FlexChild a b -> b
basis Double
rsize [FlexChild a Double]
row
                (Flex a Double -> Double
forall a b. Flex a b -> b
baseGap Flex a Double
self) (Justification -> Maybe Justification -> Justification
forall a. a -> Maybe a -> a
fromMaybe Justification
JSpaceAround (Maybe Justification -> Justification)
-> Maybe Justification -> Justification
forall a b. (a -> b) -> a -> b
$ Flex a Double -> Maybe Justification
forall a b. Flex a b -> Maybe Justification
alignLines Flex a Double
self)
    alignChild :: Double -> Double -> (Double, FlexChild a b) -> FlexChild b b
alignChild Double
rsize Double
rpos (Double
kpos, kid :: FlexChild a b
kid@FlexChild {
        flexInner :: forall a b. FlexChild a b -> a
flexInner = a
kid', alignment :: forall a b. FlexChild a b -> Alignment
alignment = Alignment
align'
      }) = FlexChild a b
kid {
        flexInner :: b
flexInner = ((Double, Double) -> a -> b) -> a -> (Double, Double) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Double, Double) -> a -> b
cb a
kid' ((Double, Double) -> b) -> (Double, Double) -> b
forall a b. (a -> b) -> a -> b
$ Double -> Double -> (Double, Double)
sz Double
kpos (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$
                Double
rpos Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double -> Alignment -> Double
alignOffset Double
rsize ((Size Double Double -> Direction -> Double)
-> Direction -> Size Double Double -> Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip Size Double Double -> Direction -> Double
forall m. Num m => Size m m -> Direction -> m
sizeCross Direction
dir (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ a -> Size Double Double
cb' a
kid') Alignment
align'
      }
    sz :: Double -> Double -> (Double, Double)
sz Double
m Double
c | Direction
Row <- Flex a Double -> Direction
forall a b. Flex a b -> Direction
direction Flex a Double
self = (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
m, Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c)
        | Bool
otherwise = (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c, Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
m)