module Halogen.HTML.Layout where
import Data.Default
import HPrelude hiding ((>>))
import Halogen.HTML qualified as HH
class Layout (f :: Type -> Type -> Type) where
data LayoutSettings f
data LayoutConstraints f
layout :: LayoutSettings f -> f w i -> HH.HTML w i
layoutEnd :: f w i
addComponent :: LayoutConstraints f -> HH.HTML w i -> f w i -> f w i
addComponent' :: (Layout f, Default (LayoutConstraints f)) => HH.HTML w i -> f w i -> f w i
addComponent' :: forall (f :: * -> * -> *) w i.
(Layout f, Default (LayoutConstraints f)) =>
HTML w i -> f w i -> f w i
addComponent' = LayoutConstraints f -> HTML w i -> f w i -> f w i
forall w i. LayoutConstraints f -> HTML w i -> f w i -> f w i
forall (f :: * -> * -> *) w i.
Layout f =>
LayoutConstraints f -> HTML w i -> f w i -> f w i
addComponent LayoutConstraints f
forall a. Default a => a
def
layout' :: (Layout f, Default (LayoutSettings f)) => f w i -> HH.HTML w i
layout' :: forall (f :: * -> * -> *) w i.
(Layout f, Default (LayoutSettings f)) =>
f w i -> HTML w i
layout' = LayoutSettings f -> f w i -> HTML w i
forall w i. LayoutSettings f -> f w i -> HTML w i
forall (f :: * -> * -> *) w i.
Layout f =>
LayoutSettings f -> f w i -> HTML w i
layout LayoutSettings f
forall a. Default a => a
def
addComponentIf :: (Layout f) => Bool -> LayoutConstraints f -> HH.HTML w i -> f w i -> f w i
addComponentIf :: forall (f :: * -> * -> *) w i.
Layout f =>
Bool -> LayoutConstraints f -> HTML w i -> f w i -> f w i
addComponentIf Bool
b LayoutConstraints f
c HTML w i
h f w i
a = if Bool
b then LayoutConstraints f -> HTML w i -> f w i -> f w i
forall w i. LayoutConstraints f -> HTML w i -> f w i -> f w i
forall (f :: * -> * -> *) w i.
Layout f =>
LayoutConstraints f -> HTML w i -> f w i -> f w i
addComponent LayoutConstraints f
c HTML w i
h f w i
a else f w i
a
addComponentIf' :: (Layout f, Default (LayoutConstraints f)) => Bool -> HH.HTML w i -> f w i -> f w i
addComponentIf' :: forall (f :: * -> * -> *) w i.
(Layout f, Default (LayoutConstraints f)) =>
Bool -> HTML w i -> f w i -> f w i
addComponentIf' Bool
b HTML w i
h f w i
a = Bool -> LayoutConstraints f -> HTML w i -> f w i -> f w i
forall (f :: * -> * -> *) w i.
Layout f =>
Bool -> LayoutConstraints f -> HTML w i -> f w i -> f w i
addComponentIf Bool
b LayoutConstraints f
forall a. Default a => a
def HTML w i
h f w i
a
newtype LayoutM f w i = LayoutM (f w i -> f w i)
runLayoutM :: (Layout f) => LayoutSettings f -> LayoutM f w i -> HH.HTML w i
runLayoutM :: forall (f :: * -> * -> *) w i.
Layout f =>
LayoutSettings f -> LayoutM f w i -> HTML w i
runLayoutM LayoutSettings f
settings (LayoutM f w i -> f w i
f) = LayoutSettings f -> f w i -> HTML w i
forall w i. LayoutSettings f -> f w i -> HTML w i
forall (f :: * -> * -> *) w i.
Layout f =>
LayoutSettings f -> f w i -> HTML w i
layout LayoutSettings f
settings (f w i -> HTML w i) -> f w i -> HTML w i
forall a b. (a -> b) -> a -> b
$ f w i -> f w i
f f w i
forall w i. f w i
forall (f :: * -> * -> *) w i. Layout f => f w i
layoutEnd
end :: (Layout f) => LayoutM f w i
end :: forall (f :: * -> * -> *) w i. Layout f => LayoutM f w i
end = (f w i -> f w i) -> LayoutM f w i
forall {k} {k} (f :: k -> k -> *) (w :: k) (i :: k).
(f w i -> f w i) -> LayoutM f w i
LayoutM f w i -> f w i
forall a. a -> a
identity
class (Layout f) => AddLayout f w i a | a -> w i where
(>>) :: a -> LayoutM f w i -> LayoutM f w i
instance (AddLayout f w i a) => AddLayout f w i (Bool, a) where
(Bool
b, a
f) >> :: (Bool, a) -> LayoutM f w i -> LayoutM f w i
>> LayoutM f w i
g = if Bool
b then a
f a -> LayoutM f w i -> LayoutM f w i
forall (f :: * -> * -> *) w i a.
AddLayout f w i a =>
a -> LayoutM f w i -> LayoutM f w i
>> LayoutM f w i
g else LayoutM f w i
g
instance (Layout f) => AddLayout f w i (LayoutConstraints f, HH.HTML w i) where
(LayoutConstraints f
c, HTML w i
h) >> :: (LayoutConstraints f, HTML w i) -> LayoutM f w i -> LayoutM f w i
>> LayoutM f w i -> f w i
f = (f w i -> f w i) -> LayoutM f w i
forall {k} {k} (f :: k -> k -> *) (w :: k) (i :: k).
(f w i -> f w i) -> LayoutM f w i
LayoutM ((f w i -> f w i) -> LayoutM f w i)
-> (f w i -> f w i) -> LayoutM f w i
forall a b. (a -> b) -> a -> b
$ f w i -> f w i
f (f w i -> f w i) -> (f w i -> f w i) -> f w i -> f w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutConstraints f -> HTML w i -> f w i -> f w i
forall w i. LayoutConstraints f -> HTML w i -> f w i -> f w i
forall (f :: * -> * -> *) w i.
Layout f =>
LayoutConstraints f -> HTML w i -> f w i -> f w i
addComponent LayoutConstraints f
c HTML w i
h
instance (Layout f, Default (LayoutConstraints f)) => AddLayout f w i (HH.HTML w i) where
HTML w i
html >> :: HTML w i -> LayoutM f w i -> LayoutM f w i
>> LayoutM f w i -> f w i
f = (f w i -> f w i) -> LayoutM f w i
forall {k} {k} (f :: k -> k -> *) (w :: k) (i :: k).
(f w i -> f w i) -> LayoutM f w i
LayoutM ((f w i -> f w i) -> LayoutM f w i)
-> (f w i -> f w i) -> LayoutM f w i
forall a b. (a -> b) -> a -> b
$ f w i -> f w i
f (f w i -> f w i) -> (f w i -> f w i) -> f w i -> f w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> * -> *) w i.
Layout f =>
LayoutConstraints f -> HTML w i -> f w i -> f w i
addComponent @f LayoutConstraints f
forall a. Default a => a
def HTML w i
html
instance (Layout f) => AddLayout f w i (f w i -> f w i) where
f w i -> f w i
f >> :: (f w i -> f w i) -> LayoutM f w i -> LayoutM f w i
>> LayoutM f w i
l = (Bool
True, f w i -> f w i
f) (Bool, f w i -> f w i) -> LayoutM f w i -> LayoutM f w i
forall (f :: * -> * -> *) w i a.
AddLayout f w i a =>
a -> LayoutM f w i -> LayoutM f w i
>> LayoutM f w i
l
infixr 1 >>
if_ :: Bool -> a -> (Bool, a)
if_ :: forall a. Bool -> a -> (Bool, a)
if_ = (,)
with :: LayoutConstraints f -> HH.HTML w i -> (LayoutConstraints f, HH.HTML w i)
with :: forall (f :: * -> * -> *) w i.
LayoutConstraints f -> HTML w i -> (LayoutConstraints f, HTML w i)
with = (,)