module Halogen.HTML.Layout.GridLayout where
import Clay qualified as C
import Data.Default
import HPrelude
import Halogen.HTML.Layout
import Halogen.HTML.Layout.GridBagLayout
newtype GridLayout w i = GridLayout (GridBagLayout w i)
defGridSettings :: LayoutSettings GridLayout
defGridSettings :: LayoutSettings GridLayout
defGridSettings = LayoutSettings GridLayout
forall a. Default a => a
def
instance Default (LayoutSettings GridLayout) where
def :: LayoutSettings GridLayout
def =
GridLayoutSettings
{ rows :: Int
rows = Int
0
, cols :: Int
cols = Int
0
, gap :: forall a. Maybe (Size a)
gap = Maybe (Size a)
forall a. Maybe a
forall a. Maybe (Size a)
Nothing
, width :: forall a. Maybe (Size a)
width = Maybe (Size a)
forall a. Maybe a
forall a. Maybe (Size a)
Nothing
, height :: forall a. Maybe (Size a)
height = Maybe (Size a)
forall a. Maybe a
forall a. Maybe (Size a)
Nothing
}
instance Layout GridLayout where
data LayoutConstraints _ = GridLayoutConstraints
{ LayoutConstraints GridLayout -> Int
gridx :: Int
, LayoutConstraints GridLayout -> Int
gridy :: Int
}
data LayoutSettings _ = GridLayoutSettings
{ LayoutSettings GridLayout -> Int
rows :: Int
, LayoutSettings GridLayout -> Int
cols :: Int
, LayoutSettings GridLayout -> forall a. Maybe (Size a)
gap :: forall a. Maybe (C.Size a)
, LayoutSettings GridLayout -> forall a. Maybe (Size a)
width :: forall a. Maybe (C.Size a)
, LayoutSettings GridLayout -> forall a. Maybe (Size a)
height :: forall a. Maybe (C.Size a)
}
layout :: forall w i. LayoutSettings GridLayout -> GridLayout w i -> HTML w i
layout GridLayoutSettings {Int
forall a. Maybe (Size a)
rows :: LayoutSettings GridLayout -> Int
cols :: LayoutSettings GridLayout -> Int
gap :: LayoutSettings GridLayout -> forall a. Maybe (Size a)
width :: LayoutSettings GridLayout -> forall a. Maybe (Size a)
height :: LayoutSettings GridLayout -> forall a. Maybe (Size a)
rows :: Int
cols :: Int
gap :: forall a. Maybe (Size a)
width :: forall a. Maybe (Size a)
height :: forall a. Maybe (Size a)
..} (GridLayout GridBagLayout w i
gbl) =
LayoutSettings GridBagLayout -> GridBagLayout w i -> HTML w i
forall w i.
LayoutSettings GridBagLayout -> GridBagLayout w i -> HTML w i
forall (f :: * -> * -> *) w i.
Layout f =>
LayoutSettings f -> f w i -> HTML w i
layout GridBagLayoutSettings {Int
Maybe (Size a)
Maybe (Size a)
Maybe (Size a)
forall a. Maybe (Size a)
rows :: Int
cols :: Int
gap :: forall a. Maybe (Size a)
width :: forall a. Maybe (Size a)
height :: forall a. Maybe (Size a)
cols :: Int
gap :: forall a. Maybe (Size a)
height :: forall a. Maybe (Size a)
rows :: Int
width :: forall a. Maybe (Size a)
..} GridBagLayout w i
gbl
layoutEnd :: forall w i. GridLayout w i
layoutEnd = GridBagLayout w i -> GridLayout w i
forall w i. GridBagLayout w i -> GridLayout w i
GridLayout (GridBagLayout w i -> GridLayout w i)
-> GridBagLayout w i -> GridLayout w i
forall a b. (a -> b) -> a -> b
$ [(LayoutConstraints GridBagLayout, HTML w i)] -> GridBagLayout w i
forall w i.
[(LayoutConstraints GridBagLayout, HTML w i)] -> GridBagLayout w i
GridBagLayout []
addComponent :: forall w i.
LayoutConstraints GridLayout
-> HTML w i -> GridLayout w i -> GridLayout w i
addComponent GridLayoutConstraints {Int
gridx :: LayoutConstraints GridLayout -> Int
gridy :: LayoutConstraints GridLayout -> Int
gridx :: Int
gridy :: Int
..} HTML w i
h (GridLayout GridBagLayout w i
gbl) =
GridBagLayout w i -> GridLayout w i
forall w i. GridBagLayout w i -> GridLayout w i
GridLayout (GridBagLayout w i -> GridLayout w i)
-> GridBagLayout w i -> GridLayout w i
forall a b. (a -> b) -> a -> b
$ LayoutConstraints GridBagLayout
-> HTML w i -> GridBagLayout w i -> GridBagLayout w i
forall w i.
LayoutConstraints GridBagLayout
-> HTML w i -> GridBagLayout w i -> GridBagLayout w i
forall (f :: * -> * -> *) w i.
Layout f =>
LayoutConstraints f -> HTML w i -> f w i -> f w i
addComponent GridBagLayoutConstraints {gridwidth :: Int
gridwidth = Int
1, gridheight :: Int
gridheight = Int
1, Int
gridx :: Int
gridy :: Int
gridx :: Int
gridy :: Int
..} HTML w i
h GridBagLayout w i
gbl