module Halogen.HTML.Layout.BoxLayout where

import Clay 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 BoxLayout w i = BoxLayout [HH.HTML w i]

settingsToDir :: LayoutSettings BoxLayout -> C.FlexDirection
settingsToDir :: LayoutSettings BoxLayout -> FlexDirection
settingsToDir LayoutSettings BoxLayout
R:LayoutSettingsBoxLayout
Horizontal = FlexDirection
C.row
settingsToDir LayoutSettings BoxLayout
R:LayoutSettingsBoxLayout
Vertical = FlexDirection
C.column

instance Default (LayoutConstraints BoxLayout) where
  def :: LayoutConstraints BoxLayout
def = LayoutConstraints BoxLayout
Next

instance Layout BoxLayout where
  data LayoutConstraints _ = Next
  data LayoutSettings _ = Horizontal | Vertical
  layout :: forall w i. LayoutSettings BoxLayout -> BoxLayout w i -> HTML w i
layout LayoutSettings BoxLayout
settings (BoxLayout [HTML w i]
children) =
    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
$ Display -> Css
C.display Display
C.inlineFlex Css -> Css -> Css
forall a. Semigroup a => a -> a -> a
<> FlexDirection -> Css
C.flexDirection (LayoutSettings BoxLayout -> FlexDirection
settingsToDir LayoutSettings BoxLayout
settings)]
      ([HTML w i] -> HTML w i) -> [HTML w i] -> HTML w i
forall a b. (a -> b) -> a -> b
$ [HTML w i] -> [HTML w i]
forall a. [a] -> [a]
reverse [HTML w i]
children

  layoutEnd :: forall w i. BoxLayout w i
layoutEnd = [HTML w i] -> BoxLayout w i
forall w i. [HTML w i] -> BoxLayout w i
BoxLayout []
  addComponent :: forall w i.
LayoutConstraints BoxLayout
-> HTML w i -> BoxLayout w i -> BoxLayout w i
addComponent LayoutConstraints BoxLayout
R:LayoutConstraintsBoxLayout
Next HTML w i
h = ([HTML w i] -> [HTML w i]) -> BoxLayout w i -> BoxLayout w i
forall a b. Coercible a b => a -> b
coerce (HTML w i
h HTML w i -> [HTML w i] -> [HTML w i]
forall a. a -> [a] -> [a]
:)