-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall a b. (Eq b, Eq a) => Flex a b -> Flex a b -> Bool
Eq, Int -> Flex a b -> ShowS
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
showList :: [Flex a b] -> ShowS
$cshowList :: forall a b. (Show b, Show a) => [Flex a b] -> ShowS
show :: Flex a b -> String
$cshow :: forall a b. (Show b, Show a) => Flex a b -> String
showsPrec :: Int -> Flex a b -> ShowS
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> Flex a b -> ShowS
Show, ReadPrec [Flex a b]
ReadPrec (Flex a b)
ReadS [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]
readListPrec :: ReadPrec [Flex a b]
$creadListPrec :: forall a b. (Read b, Read a) => ReadPrec [Flex a b]
readPrec :: ReadPrec (Flex a b)
$creadPrec :: forall a b. (Read b, Read a) => ReadPrec (Flex a b)
readList :: ReadS [Flex a b]
$creadList :: forall a b. (Read b, Read a) => ReadS [Flex a b]
readsPrec :: Int -> ReadS (Flex a b)
$creadsPrec :: forall a b. (Read b, Read a) => Int -> ReadS (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall a b. (Eq b, Eq a) => FlexChild a b -> FlexChild a b -> Bool
Eq, Int -> FlexChild a b -> ShowS
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
showList :: [FlexChild a b] -> ShowS
$cshowList :: forall a b. (Show b, Show a) => [FlexChild a b] -> ShowS
show :: FlexChild a b -> String
$cshow :: forall a b. (Show b, Show a) => FlexChild a b -> String
showsPrec :: Int -> FlexChild a b -> ShowS
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> FlexChild a b -> ShowS
Show, ReadPrec [FlexChild a b]
ReadPrec (FlexChild a b)
ReadS [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]
readListPrec :: ReadPrec [FlexChild a b]
$creadListPrec :: forall a b. (Read b, Read a) => ReadPrec [FlexChild a b]
readPrec :: ReadPrec (FlexChild a b)
$creadPrec :: forall a b. (Read b, Read a) => ReadPrec (FlexChild a b)
readList :: ReadS [FlexChild a b]
$creadList :: forall a b. (Read b, Read a) => ReadS [FlexChild a b]
readsPrec :: Int -> ReadS (FlexChild a b)
$creadsPrec :: forall a b. (Read b, Read a) => Int -> ReadS (FlexChild a b)
Read)

-- | Which axis to position children along
data Direction = Row | Column deriving (Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Int -> ReadS Direction
$creadsPrec :: Int -> ReadS Direction
Read)
-- | Whether to wrap or reverse the wrapped lines
data FlexWrapping = NoWrap | Wrap | WrapReverse deriving (FlexWrapping -> FlexWrapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlexWrapping -> FlexWrapping -> Bool
$c/= :: FlexWrapping -> FlexWrapping -> Bool
== :: FlexWrapping -> FlexWrapping -> Bool
$c== :: FlexWrapping -> FlexWrapping -> Bool
Eq, Int -> FlexWrapping -> ShowS
[FlexWrapping] -> ShowS
FlexWrapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlexWrapping] -> ShowS
$cshowList :: [FlexWrapping] -> ShowS
show :: FlexWrapping -> String
$cshow :: FlexWrapping -> String
showsPrec :: Int -> FlexWrapping -> ShowS
$cshowsPrec :: Int -> FlexWrapping -> ShowS
Show, ReadPrec [FlexWrapping]
ReadPrec FlexWrapping
Int -> ReadS FlexWrapping
ReadS [FlexWrapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FlexWrapping]
$creadListPrec :: ReadPrec [FlexWrapping]
readPrec :: ReadPrec FlexWrapping
$creadPrec :: ReadPrec FlexWrapping
readList :: ReadS [FlexWrapping]
$creadList :: ReadS [FlexWrapping]
readsPrec :: Int -> ReadS FlexWrapping
$creadsPrec :: Int -> ReadS 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Justification -> Justification -> Bool
$c/= :: Justification -> Justification -> Bool
== :: Justification -> Justification -> Bool
$c== :: Justification -> Justification -> Bool
Eq, Int -> Justification -> ShowS
[Justification] -> ShowS
Justification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Justification] -> ShowS
$cshowList :: [Justification] -> ShowS
show :: Justification -> String
$cshow :: Justification -> String
showsPrec :: Int -> Justification -> ShowS
$cshowsPrec :: Int -> Justification -> ShowS
Show, ReadPrec [Justification]
ReadPrec Justification
Int -> ReadS Justification
ReadS [Justification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Justification]
$creadListPrec :: ReadPrec [Justification]
readPrec :: ReadPrec Justification
$creadPrec :: ReadPrec Justification
readList :: ReadS [Justification]
$creadList :: ReadS [Justification]
readsPrec :: Int -> ReadS Justification
$creadsPrec :: Int -> ReadS 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show, ReadPrec [Alignment]
ReadPrec Alignment
Int -> ReadS Alignment
ReadS [Alignment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Alignment]
$creadListPrec :: ReadPrec [Alignment]
readPrec :: ReadPrec Alignment
$creadPrec :: ReadPrec Alignment
readList :: ReadS [Alignment]
$creadList :: ReadS [Alignment]
readsPrec :: Int -> ReadS Alignment
$creadsPrec :: Int -> ReadS 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 = forall a b. Flex a b -> Direction
direction Flex a c
self, reverseRows :: Bool
reverseRows = forall a b. Flex a b -> Bool
reverseRows Flex a c
self, wrap :: FlexWrapping
wrap = forall a b. Flex a b -> FlexWrapping
wrap Flex a c
self,
    justify :: Justification
justify = forall a b. Flex a b -> Justification
justify Flex a c
self, alignLines :: Maybe Justification
alignLines = forall a b. Flex a b -> Maybe Justification
alignLines Flex a c
self,
    baseGap :: c
baseGap = forall a b. Flex a b -> b
baseGap Flex a c
self, crossGap :: c
crossGap = forall a b. Flex a b -> b
crossGap Flex a c
self, pageWidth :: Double
pageWidth = forall a b. Flex a b -> Double
pageWidth Flex a c
self,
    children :: [[FlexChild b c]]
children = [[FlexChild {
        grow :: Double
grow = forall a b. FlexChild a b -> Double
grow FlexChild a c
kid, shrink :: Double
shrink = forall a b. FlexChild a b -> Double
shrink FlexChild a c
kid, basis :: c
basis = forall a b. FlexChild a b -> b
basis FlexChild a c
kid,
        alignment :: Alignment
alignment = forall a b. FlexChild a b -> Alignment
alignment FlexChild a c
kid,
        flexInner :: b
flexInner = a -> b
cb forall a b. (a -> b) -> a -> b
$ 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 <- 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 = forall a b. Flex a b -> Direction
direction Flex a b
self, reverseRows :: Bool
reverseRows = forall a b. Flex a b -> Bool
reverseRows Flex a b
self, wrap :: FlexWrapping
wrap = forall a b. Flex a b -> FlexWrapping
wrap Flex a b
self,
    justify :: Justification
justify = forall a b. Flex a b -> Justification
justify Flex a b
self, alignLines :: Maybe Justification
alignLines = forall a b. Flex a b -> Maybe Justification
alignLines Flex a b
self,
    baseGap :: Double
baseGap = forall a. CastDouble a => Double -> a -> Double
toDoubleWithin Double
size forall a b. (a -> b) -> a -> b
$ forall a b. Flex a b -> b
baseGap Flex a b
self,
    crossGap :: Double
crossGap = forall a. CastDouble a => Double -> a -> Double
toDoubleWithin Double
size forall a b. (a -> b) -> a -> b
$ forall a b. Flex a b -> b
crossGap Flex a b
self,
    pageWidth :: Double
pageWidth = forall a b. Flex a b -> Double
pageWidth Flex a b
self,
    children :: [[FlexChild a Double]]
children = [[FlexChild {
        grow :: Double
grow = forall a b. FlexChild a b -> Double
grow FlexChild a b
kid, shrink :: Double
shrink = forall a b. FlexChild a b -> Double
shrink FlexChild a b
kid,
        basis :: Double
basis = forall a. CastDouble a => Double -> Double -> a -> Double
toDoubleWithinAuto (forall a b. FlexChild a b -> a
flexInner FlexChild a b
kid a -> Direction -> Double
`cb` forall a b. Flex a b -> Direction
direction Flex a b
self) Double
size forall a b. (a -> b) -> a -> b
$ forall a b. FlexChild a b -> b
basis FlexChild a b
kid,
        alignment :: Alignment
alignment = forall a b. FlexChild a b -> Alignment
alignment FlexChild a b
kid, flexInner :: a
flexInner = forall a b. FlexChild a b -> a
flexInner FlexChild a b
kid
    } | FlexChild a b
kid <- [FlexChild a b]
row] | [FlexChild a b]
row <- 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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [forall a b. FlexChild a b -> b
basis FlexChild a Double
child | [FlexChild a Double]
row <- 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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum forall a b. (a -> b) -> a -> b
$
        forall a. a -> [a] -> [a]
intersperse (forall a b. Flex a b -> b
baseGap Flex a Double
self) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. FlexChild a b -> b
basis [FlexChild a Double]
row | [FlexChild a Double]
row <- 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 <- forall a b. Flex a b -> FlexWrapping
wrap Flex a b
self = forall b a. CastDouble b => Flex a b -> Flex a b
post Flex a b
self
    | FlexWrapping
Wrap <- forall a b. Flex a b -> FlexWrapping
wrap Flex a b
self = forall b a. CastDouble b => Flex a b -> Flex a b
post Flex a b
self'
    | FlexWrapping
WrapReverse <- forall a b. Flex a b -> FlexWrapping
wrap Flex a b
self = forall b a. CastDouble b => Flex a b -> Flex a b
post Flex a b
self' { children :: [[FlexChild a b]]
children=forall a. [a] -> [a]
reverse forall a b. (a -> b) -> 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall b a. CastDouble b => [FlexChild a b] -> [[FlexChild a b]]
wrapRow forall a b. (a -> b) -> 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) = forall b a.
CastDouble b =>
[FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
splitRow' [FlexChild a b]
kids forall a b. (a -> b) -> a -> b
$ forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid
        in [FlexChild a b]
rowforall a. a -> [a] -> [a]
: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) = forall b a.
CastDouble b =>
[FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
splitRow [FlexChild a b]
kids (Double
end forall a. Num a => a -> a -> a
+ forall b a. CastDouble b => Flex a b -> Double
baseGap' Flex a b
self forall a. Num a => a -> a -> a
+ forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid)
        in (FlexChild a b
kidforall 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 forall a. Ord a => a -> a -> Bool
> Double
size = ([], FlexChild a b
kidforall a. a -> [a] -> [a]
:[FlexChild a b]
kids)
        | Bool
otherwise = let ([FlexChild a b]
kids', [FlexChild a b]
rest) = forall b a.
CastDouble b =>
[FlexChild a b] -> Double -> ([FlexChild a b], [FlexChild a b])
splitRow [FlexChild a b]
kids (Double
end forall a. Num a => a -> a -> a
+ forall b a. CastDouble b => Flex a b -> Double
baseGap' Flex a b
self forall a. Num a => a -> a -> a
+ forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid)
            in (FlexChild a b
kidforall 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
        | forall a b. Flex a b -> Bool
reverseRows Flex a b
self = forall b a. CastDouble b => Flex a b -> Flex a b
post' Flex a b
flex { children :: [[FlexChild a b]]
children = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. Flex a b -> [[FlexChild a b]]
children Flex a b
flex }
        | Bool
otherwise = 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 = forall a b. (a -> b) -> [a] -> [b]
map forall b a. CastDouble b => [FlexChild a b] -> [FlexChild a b]
resizeRow forall a b. (a -> b) -> 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 forall a. Ord a => a -> a -> Bool
> Double
size = [FlexChild a b
kid {
                basis :: b
basis = forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid forall a. Num a => a -> a -> a
- forall a b. FlexChild a b -> Double
shrink FlexChild a b
kid forall a. Num a => a -> a -> a
* forall {a}. RealFloat a => a -> a
nanguard Double
sfr
            } | FlexChild a b
kid <- [FlexChild a b]
row]
        | Double
rowSize forall a. Ord a => a -> a -> Bool
< Double
size = [FlexChild a b
kid {
                basis :: b
basis = forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall b a. CastDouble b => FlexChild a b -> Double
basis' FlexChild a b
kid forall a. Num a => a -> a -> a
+ forall a b. FlexChild a b -> Double
grow FlexChild a b
kid forall a. Num a => a -> a -> a
* 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (forall b a. CastDouble b => Flex a b -> Double
baseGap' Flex a b
self) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall b a. CastDouble b => FlexChild a b -> Double
basis' [FlexChild a b]
row
        sfr :: Double
sfr = (Double
rowSize forall a. Num a => a -> a -> a
- Double
size)forall a. Fractional a => a -> a -> a
/(forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. FlexChild a b -> Double
shrink [FlexChild a b]
row)
        gfr :: Double
gfr = (Double
size forall a. Num a => a -> a -> a
- Double
rowSize)forall a. Fractional a => a -> a -> a
/(forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. FlexChild a b -> Double
grow [FlexChild a b]
row)
        nanguard :: a -> a
nanguard a
x | forall a. RealFloat a => a -> Bool
isNaN a
x = a
0
            | 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' = forall a. CastDouble a => a -> Double
toDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' = forall a. CastDouble a => a -> Double
toDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (a -> Double
cb forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 } =
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Double
gap forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize a -> Double
cb 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 forall a. Num a => a -> a -> a
- forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks
justifyOffset Double
outersize [Double]
ks Double
g Justification
JCenter = Double -> Double
half forall a b. (a -> b) -> a -> b
$ Double
outersize forall a. Num a => a -> a -> a
- 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 forall a b. (a -> b) -> a -> b
$ (Double
outersize forall a. Num a => a -> a -> a
- forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)forall a. Fractional a => a -> a -> a
/forall a. [a] -> Double
length' [Double]
ks
justifyOffset Double
_ [Double]
ks Double
_ Justification
_ | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ks 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 forall a. Num a => a -> a -> a
- forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)forall a. Fractional a => a -> a -> a
/(forall a. [a] -> Double
length' [Double]
ks 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 forall a. Num a => a -> a -> a
- forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)forall a. Fractional a => a -> a -> a
/(forall a. [a] -> Double
length' [Double]
ks forall a. Num a => a -> a -> a
- Double
1)
justifySpacing Double
size [Double]
ks Double
g Justification
JSpaceAround = (Double
size forall a. Num a => a -> a -> a
- forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)forall a. Fractional a => a -> a -> a
/forall a. [a] -> Double
length' [Double]
ks
justifySpacing Double
size [Double]
ks Double
g Justification
JSpaceEvenly = (Double
size forall a. Num a => a -> a -> a
- forall {c}. Num c => c -> [c] -> c
innersize Double
g [Double]
ks)forall a. Fractional a => a -> a -> a
/(forall a. [a] -> Double
length' [Double]
ks 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' = 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)forall a. a -> [a] -> [a]
:[a] -> Double -> [(Double, a)]
inner [a]
ks (Double
start forall a. Num a => a -> a -> a
+ a -> Double
cb a
k 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 forall a. Num a => a -> a -> a
- Double
inner
alignOffset Double
outer Double
inner Alignment
AlCenter = Double -> Double
half forall a b. (a -> b) -> a -> b
$ Double
outer forall a. Num a => a -> a -> a
- Double
inner
alignOffset Double
outer Double
inner Alignment
AlBaseline = Double -> Double
half forall a b. (a -> b) -> a -> b
$ Double
outer 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse c
gap
-- | divide by 2, can be syntactically in certain circumstances.
half :: Double -> Double
half = (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' = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall {a} {m}. Num a => PaddedBox m a -> a
minWidth PaddedBox m m
box
outerMinMain PaddedBox m m
box Direction
Column = 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 = forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox m m
box
outerMain PaddedBox m m
box Direction
Column = 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 = forall {a} {m}. Num a => PaddedBox m a -> a
maxWidth PaddedBox m m
box
outerMaxMain PaddedBox m m
box Direction
Column = 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 = forall {a} {n}. Num a => PaddedBox a n -> a
minHeight PaddedBox m m
box
outerMinCross PaddedBox m m
box Direction
Column = 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 = forall {a} {n}. Num a => PaddedBox a n -> a
height PaddedBox m m
box
outerCross PaddedBox m m
box Direction
Column = 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 = forall {a} {n}. Num a => PaddedBox a n -> a
maxHeight PaddedBox m m
box
outerMaxCross PaddedBox m m
box Direction
Column = 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 = forall m. Num m => Size m m -> Direction -> m
sizeMain forall a b. (a -> b) -> a -> b
$ 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 = forall m. Num m => Size m m -> Direction -> m
sizeMain forall a b. (a -> b) -> a -> b
$ 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 = forall m. Num m => Size m m -> Direction -> m
sizeMain forall a b. (a -> b) -> a -> b
$ 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 = forall m. Num m => Size m m -> Direction -> m
sizeCross forall a b. (a -> b) -> a -> b
$ 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 = forall m. Num m => Size m m -> Direction -> m
sizeCross forall a b. (a -> b) -> a -> b
$ 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 = forall m. Num m => Size m m -> Direction -> m
sizeCross forall a b. (a -> b) -> a -> b
$ 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 = forall m n. Size m n -> n
inline Size m m
self
sizeMain Size m m
self Direction
Column = 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 = forall m n. Size m n -> m
block Size m m
self
sizeCross Size m m
self Direction
Column = 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 = forall a. Zero a => a
zero {
    min :: Size m n
B.min = forall a. Flex a Double -> Double
flexMaxBasis Flex a Double
self' forall {n} {m}.
(CastDouble n, CastDouble m) =>
Double -> Double -> Size m n
`size` forall a. (a -> Double) -> Flex a Double -> Double
flexRowsSize (forall {c}. (PaddedBox Double Double -> Direction -> c) -> a -> c
cb' forall m. Num m => PaddedBox m m -> Direction -> m
innerMinCross) Flex a Double
self',
    max :: Size m n
B.max = forall a. Fractional a => Rational -> a
fromRational Rational
infinity forall {n} {m}.
(CastDouble n, CastDouble m) =>
Double -> Double -> Size m n
`size` forall a. Fractional a => Rational -> a
fromRational Rational
infinity,
    nat :: Size Double Double
B.nat = forall a. Flex a Double -> Double
flexSumBasis Flex a Double
self' forall {n} {m}.
(CastDouble n, CastDouble m) =>
Double -> Double -> Size m n
`size` forall a. (a -> Double) -> Flex a Double -> Double
flexRowsSize (forall {c}. (PaddedBox Double Double -> Direction -> c) -> a -> c
cb' forall m. Num m => PaddedBox m m -> Direction -> m
innerCross) Flex a Double
self',
    size :: Size m n
B.size = forall a. Flex a Double -> Double
flexSumBasis Flex a Double
self' forall {n} {m}.
(CastDouble n, CastDouble m) =>
Double -> Double -> Size m n
`size` forall a. (a -> Double) -> Flex a Double -> Double
flexRowsSize (forall {c}. (PaddedBox Double Double -> Direction -> c) -> a -> c
cb' 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 <- forall a b. Flex a b -> Direction
direction Flex a m
self = forall a. CastDouble a => Double -> a
fromDouble Double
main forall m n. n -> m -> Size m n
`Size` forall a. CastDouble a => Double -> a
fromDouble Double
cross
        | Bool
otherwise = forall a. CastDouble a => Double -> a
fromDouble Double
cross forall m n. n -> m -> Size m n
`Size` forall a. CastDouble a => Double -> a
fromDouble Double
main
    cb' :: (PaddedBox Double Double -> Direction -> c) -> a -> c
cb' PaddedBox Double Double -> Direction -> c
cb_ = forall a b c. (a -> b -> c) -> b -> a -> c
flip PaddedBox Double Double -> Direction -> c
cb_ (forall a b. Flex a b -> Direction
direction Flex a m
self) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PaddedBox Double Double
cb
    self' :: Flex a Double
self' = forall b a.
CastDouble b =>
(a -> Direction -> Double) -> Double -> Flex a b -> Flex a Double
flexResolve (forall m. Num m => PaddedBox m m -> Direction -> m
innerMain 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' = 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) = forall {b}.
Double
-> [[FlexChild a b]] -> ([[FlexChild a b]], [[FlexChild a b]])
splitRows (-forall a b. Flex a b -> b
crossGap Flex a Double
self) forall a b. (a -> b) -> a -> b
$ 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 forall a. Ord a => a -> a -> Bool
>= Double
h = ([], [FlexChild a b]
rowforall a. a -> [a] -> [a]
:[[FlexChild a b]]
rows)
        | Bool
otherwise =
            let ([[FlexChild a b]]
rows', [[FlexChild a b]]
rest) = 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 forall a b. (a -> b) -> a -> b
$
                    Double
start forall a. Num a => a -> a -> a
+ forall a b. Flex a b -> b
crossGap Flex a Double
self forall a. Num a => a -> a -> a
+ forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize (forall m n. Size m n -> n
inline forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Size Double Double
cb) [FlexChild a b]
row
            in ([FlexChild a b]
rowforall 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 = (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 forall a b. (a -> b) -> a -> b
$ Double -> Bool
measure Double
h' = 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 = [] }, 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 = (forall m n. Size m n -> m
block forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Size Double Double
cb) forall a. (a -> Double) -> Flex a Double -> Double
`flexRowsSize` forall b a. CastDouble b => Flex a b -> Double -> Flex a b
flexWrap Flex a Double
self Double
space 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 = forall a b. (a -> b) -> [a] -> [b]
map (Double, [FlexChild a Double]) -> [FlexChild b Double]
rowPosition forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Double)
-> Double -> [a] -> Double -> Justification -> [(Double, a)]
flexJustify forall {b}. [FlexChild a b] -> Double
rowsize (forall m. Num m => Size m m -> Direction -> m
sizeCross Size Double Double
size Direction
dir)
            (forall a b. Flex a b -> [[FlexChild a b]]
children Flex a Double
self) (forall a b. Flex a b -> b
crossGap Flex a Double
self) (forall a b. Flex a b -> Justification
justify Flex a Double
self)
  } where
    rowsize :: [FlexChild a b] -> Double
rowsize = forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m. Num m => Size m m -> Direction -> m
sizeCross Direction
dir 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 = forall a b. (a -> Double) -> [FlexChild a b] -> Double
flexRowSize (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m. Num m => Size m m -> Direction -> m
sizeCross Direction
dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Size Double Double
cb') [FlexChild a Double]
row
        in forall a b. (a -> b) -> [a] -> [b]
map (forall {b}.
Double -> Double -> (Double, FlexChild a b) -> FlexChild b b
alignChild Double
rsize Double
rpos) forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Double)
-> Double -> [a] -> Double -> Justification -> [(Double, a)]
flexJustify forall a b. FlexChild a b -> b
basis Double
rsize [FlexChild a Double]
row
                (forall a b. Flex a b -> b
baseGap Flex a Double
self) (forall a. a -> Maybe a -> a
fromMaybe Justification
JSpaceAround forall a b. (a -> b) -> a -> b
$ 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip (Double, Double) -> a -> b
cb a
kid' forall a b. (a -> b) -> a -> b
$ Double -> Double -> (Double, Double)
sz Double
kpos forall a b. (a -> b) -> a -> b
$
                Double
rpos forall a. Num a => a -> a -> a
+ Double -> Double -> Alignment -> Double
alignOffset Double
rsize (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m. Num m => Size m m -> Direction -> m
sizeCross Direction
dir 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 <- forall a b. Flex a b -> Direction
direction Flex a Double
self = (Double
x forall a. Num a => a -> a -> a
+ Double
m, Double
y forall a. Num a => a -> a -> a
+ Double
c)
        | Bool
otherwise = (Double
x forall a. Num a => a -> a -> a
+ Double
c, Double
y forall a. Num a => a -> a -> a
+ Double
m)