module Halogen.HTML.Layout.GridBagLayout where

import Clay qualified as C
import Clay.Extra.Grid qualified as C
import Data.Default
import HPrelude
import Halogen.HTML qualified as HH
import Halogen.HTML.Layout
import Halogen.HTML.Properties qualified as HP

newtype GridBagLayout w i = GridBagLayout [(LayoutConstraints GridBagLayout, HH.HTML w i)]

gridBagLayoutStyle :: LayoutSettings GridBagLayout -> C.Css
gridBagLayoutStyle :: LayoutSettings GridBagLayout -> Css
gridBagLayoutStyle GridBagLayoutSettings {Int
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 :: LayoutSettings GridBagLayout -> Int
gap :: LayoutSettings GridBagLayout -> forall a. Maybe (Size a)
height :: LayoutSettings GridBagLayout -> forall a. Maybe (Size a)
rows :: LayoutSettings GridBagLayout -> Int
width :: LayoutSettings GridBagLayout -> forall a. Maybe (Size a)
..} = do
  Display -> Css
C.display Display
C.inlineGrid
  [Size LengthUnit] -> Css
forall a. [Size a] -> Css
C.gridTemplateColumns ([Size LengthUnit] -> Css) -> [Size LengthUnit] -> Css
forall a b. (a -> b) -> a -> b
$ Int -> Size LengthUnit -> [Size LengthUnit]
forall a. Int -> a -> [a]
replicate Int
cols (Size LengthUnit -> [Size LengthUnit])
-> Size LengthUnit -> [Size LengthUnit]
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
C.fr Number
1
  [Size LengthUnit] -> Css
forall a. [Size a] -> Css
C.gridTemplateRows ([Size LengthUnit] -> Css) -> [Size LengthUnit] -> Css
forall a b. (a -> b) -> a -> b
$ Int -> Size LengthUnit -> [Size LengthUnit]
forall a. Int -> a -> [a]
replicate Int
rows (Size LengthUnit -> [Size LengthUnit])
-> Size LengthUnit -> [Size LengthUnit]
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
C.fr Number
1

  (Size (ZonkAny 0) -> Css) -> Maybe (Size (ZonkAny 0)) -> Css
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Size (ZonkAny 0) -> Css
forall a. Size a -> Css
C.gridGap Maybe (Size (ZonkAny 0))
forall a. Maybe (Size a)
gap
  (Size (ZonkAny 1) -> Css) -> Maybe (Size (ZonkAny 1)) -> Css
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Size (ZonkAny 1) -> Css
forall a. Size a -> Css
C.width Maybe (Size (ZonkAny 1))
forall a. Maybe (Size a)
width
  (Size (ZonkAny 2) -> Css) -> Maybe (Size (ZonkAny 2)) -> Css
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Size (ZonkAny 2) -> Css
forall a. Size a -> Css
C.height Maybe (Size (ZonkAny 2))
forall a. Maybe (Size a)
height

defGridBagSettings :: LayoutSettings GridBagLayout
defGridBagSettings :: LayoutSettings GridBagLayout
defGridBagSettings = LayoutSettings GridBagLayout
forall a. Default a => a
def

instance Default (LayoutSettings GridBagLayout) where
  def :: LayoutSettings GridBagLayout
def =
    GridBagLayoutSettings
      { rows :: Int
rows = Int
1
      , cols :: Int
cols = Int
1
      , 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 GridBagLayout where
  data LayoutConstraints _ = GridBagLayoutConstraints
    { LayoutConstraints GridBagLayout -> Int
gridx :: Int
    , LayoutConstraints GridBagLayout -> Int
gridy :: Int
    , LayoutConstraints GridBagLayout -> Int
gridwidth :: Int
    , LayoutConstraints GridBagLayout -> Int
gridheight :: Int
    }

  data LayoutSettings GridBagLayout = GridBagLayoutSettings
    { LayoutSettings GridBagLayout -> Int
rows :: Int
    , LayoutSettings GridBagLayout -> Int
cols :: Int
    , LayoutSettings GridBagLayout -> forall a. Maybe (Size a)
gap :: forall a. Maybe (C.Size a)
    , LayoutSettings GridBagLayout -> forall a. Maybe (Size a)
width :: forall a. Maybe (C.Size a)
    , LayoutSettings GridBagLayout -> forall a. Maybe (Size a)
height :: forall a. Maybe (C.Size a)
    }

  layout :: forall w i.
LayoutSettings GridBagLayout -> GridBagLayout w i -> HTML w i
layout LayoutSettings GridBagLayout
settings (GridBagLayout [(LayoutConstraints GridBagLayout, HTML w i)]
hms) =
    Node HTMLdiv w i
forall w i. Node HTMLdiv w i
HH.div
      [Css -> IProp HTMLdiv i
forall (r :: Row (*)) i. HasType "style" Text r => Css -> IProp r i
HP.style (Css -> IProp HTMLdiv i) -> Css -> IProp HTMLdiv i
forall a b. (a -> b) -> a -> b
$ LayoutSettings GridBagLayout -> Css
gridBagLayoutStyle LayoutSettings GridBagLayout
settings]
      ([HTML w i] -> HTML w i) -> [HTML w i] -> HTML w i
forall a b. (a -> b) -> a -> b
$ (((LayoutConstraints GridBagLayout, HTML w i) -> HTML w i)
 -> [(LayoutConstraints GridBagLayout, HTML w i)] -> [HTML w i])
-> [(LayoutConstraints GridBagLayout, HTML w i)]
-> ((LayoutConstraints GridBagLayout, HTML w i) -> HTML w i)
-> [HTML w i]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((LayoutConstraints GridBagLayout, HTML w i) -> HTML w i)
-> [(LayoutConstraints GridBagLayout, HTML w i)] -> [HTML w i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [(LayoutConstraints GridBagLayout, HTML w i)]
hms
      (((LayoutConstraints GridBagLayout, HTML w i) -> HTML w i)
 -> [HTML w i])
-> ((LayoutConstraints GridBagLayout, HTML w i) -> HTML w i)
-> [HTML w i]
forall a b. (a -> b) -> a -> b
$ \(GridBagLayoutConstraints {Int
gridx :: LayoutConstraints GridBagLayout -> Int
gridy :: LayoutConstraints GridBagLayout -> Int
gridwidth :: LayoutConstraints GridBagLayout -> Int
gridheight :: LayoutConstraints GridBagLayout -> Int
gridx :: Int
gridy :: Int
gridwidth :: Int
gridheight :: Int
..}, HTML w i
html) ->
        Node HTMLdiv w i
forall w i. Node HTMLdiv w i
HH.div
          [ Css -> IProp HTMLdiv i
forall (r :: Row (*)) i. HasType "style" Text r => Css -> IProp r i
HP.style (Css -> IProp HTMLdiv i) -> Css -> IProp HTMLdiv i
forall a b. (a -> b) -> a -> b
$ do
              TwoGridLines -> Css
forall a. ToGridLines2 a => a -> Css
C.gridRow (TwoGridLines -> Css) -> TwoGridLines -> Css
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
gridx Integer -> GridLine -> TwoGridLines
forall b. ToGridLine b => Integer -> b -> TwoGridLines
forall a r b. (Slash a r, ToGridLine b) => a -> b -> r
C.// Integer -> GridLine
forall a. ToSpan a => a -> GridLine
C.span_ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
gridwidth)
              TwoGridLines -> Css
forall a. ToGridLines2 a => a -> Css
C.gridColumn (TwoGridLines -> Css) -> TwoGridLines -> Css
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
gridy Integer -> GridLine -> TwoGridLines
forall b. ToGridLine b => Integer -> b -> TwoGridLines
forall a r b. (Slash a r, ToGridLine b) => a -> b -> r
C.// Integer -> GridLine
forall a. ToSpan a => a -> GridLine
C.span_ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
gridheight)
          ]
          [HTML w i
html]

  layoutEnd :: forall w i. GridBagLayout w i
layoutEnd = [(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 GridBagLayout
-> HTML w i -> GridBagLayout w i -> GridBagLayout w i
addComponent LayoutConstraints GridBagLayout
constraints HTML w i
html = ([(LayoutConstraints GridBagLayout, HTML w i)]
 -> [(LayoutConstraints GridBagLayout, HTML w i)])
-> GridBagLayout w i -> GridBagLayout w i
forall a b. Coercible a b => a -> b
coerce (([(LayoutConstraints GridBagLayout, HTML w i)]
  -> [(LayoutConstraints GridBagLayout, HTML w i)])
 -> GridBagLayout w i -> GridBagLayout w i)
-> ([(LayoutConstraints GridBagLayout, HTML w i)]
    -> [(LayoutConstraints GridBagLayout, HTML w i)])
-> GridBagLayout w i
-> GridBagLayout w i
forall a b. (a -> b) -> a -> b
$ (:) (LayoutConstraints GridBagLayout
constraints, HTML w i
html)