{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Web.View.Layout where

import Data.Function
import Data.Text
import Web.View.Element
import Web.View.Style
import Web.View.Types
import Web.View.View (View, tag)


{- | We can intuitively create layouts with combinations of 'row', 'col', 'stack', 'grow', and 'space'

Wrap main content in 'layout' to allow the view to consume vertical screen space

@
holygrail :: 'View' c ()
holygrail = 'layout' id $ do
  'row' section "Top Bar"
  'row' 'grow' $ do
    'col' section "Left Sidebar"
    'col' (section . 'grow') "Main Content"
    'col' section "Right Sidebar"
  'row' section "Bottom Bar"
  where section = 'border' 1
@
-}
layout :: Mod c -> View c () -> View c ()
layout :: forall c. Mod c -> View c () -> View c ()
layout Mod c
f = Mod c -> View c () -> View c ()
forall c. Mod c -> View c () -> View c ()
el (Mod c
forall c. Mod c
root Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
f)


{- | As `layout` but as a 'Mod'

> holygrail = col root $ do
>   ...
-}
root :: Mod c
root :: forall c. Mod c
root = Mod c
forall c. Mod c
flexCol Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
forall c. Mod c
fillViewport
 where
  fillViewport :: Mod c
fillViewport =
    Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$
      ClassName -> Class
cls ClassName
"layout"
        -- [ ("white-space", "pre")
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"width" Text
"100vw"
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"height" Text
"100vh"
        -- not sure if this property is necessary, copied from older code
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"min-height" Text
"100vh"
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"z-index" Text
"0"


{- | Lay out children in a column.

> col grow $ do
>    el_ "Top"
>    space
>    el_ "Bottom"
-}
col :: Mod c -> View c () -> View c ()
col :: forall c. Mod c -> View c () -> View c ()
col Mod c
f = Mod c -> View c () -> View c ()
forall c. Mod c -> View c () -> View c ()
el (Mod c
forall c. Mod c
flexCol Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
f)


{- | Lay out children in a row

> row id $ do
>    el_ "Left"
>    space
>    el_ "Right"
-}
row :: Mod c -> View c () -> View c ()
row :: forall c. Mod c -> View c () -> View c ()
row Mod c
f = Mod c -> View c () -> View c ()
forall c. Mod c -> View c () -> View c ()
el (Mod c
forall c. Mod c
flexRow Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
f)


{- | Grow to fill the available space in the parent 'Web.View.Layout.row' or 'Web.View.Layout.col'

> row id $ do
>  el grow none
>  el_ "Right"
-}
grow :: Mod c
grow :: forall c. Mod c
grow = Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$ ClassName -> Class
cls ClassName
"grow" Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Int Text
"flex-grow" Int
1


{- | Space that fills the available space in the parent 'Web.View.Layout.row' or 'Web.View.Layout.col'.


> row id $ do
>  space
>  el_ "Right"

This is equivalent to an empty element with 'grow'

> space = el grow none
-}
space :: View c ()
space :: forall c. View c ()
space = Mod c -> View c () -> View c ()
forall c. Mod c -> View c () -> View c ()
el Mod c
forall c. Mod c
grow View c ()
forall c. View c ()
none


{- | Make a fixed 'layout' by putting 'scroll' on a child-element

> document = row root $ do
>   nav (width 300) "Sidebar"
>   col (grow . scroll) "Main Content"
-}
scroll :: Mod c
scroll :: forall c. Mod c
scroll = Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$ ClassName -> Class
cls ClassName
"scroll" Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"overflow" Text
"auto"


-- | A Nav element
nav :: Mod c -> View c () -> View c ()
nav :: forall c. Mod c -> View c () -> View c ()
nav Mod c
f = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"nav" (Mod c
f Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
forall c. Mod c
flexCol)


{- | Stack children on top of each other. Each child has the full width. See 'popout'

> stack id $ do
>   row id "Background"
>   row (bg Black . opacity 0.5) "Overlay"
-}
stack :: Mod c -> Layer c () -> View c ()
stack :: forall c. Mod c -> Layer c () -> View c ()
stack Mod c
f (Layer View c ()
children) = do
  Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"div" (Mod c
f Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
forall c. Mod c
container Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
forall c. Mod c
absChildren) View c ()
children
 where
  container :: Mod c
container =
    Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$
      ClassName -> Class
cls ClassName
"stack"
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"position" Text
"relative"
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"display" Text
"grid"
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"overflow" Text
"visible"
  absChildren :: Mod c
absChildren =
    Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$
      Selector -> Styles -> Class
Class Selector
absSelector Styles
forall a. Monoid a => a
mempty
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"grid-area" Text
"1 / 1"
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"min-height" Text
"fit-content"
  absSelector :: Selector
absSelector = (ClassName -> Selector
selector ClassName
"abs-childs"){child = Just AllChildren}


-- | A popout does not
newtype Layer c a = Layer (View c a)
  deriving newtype ((forall a b. (a -> b) -> Layer c a -> Layer c b)
-> (forall a b. a -> Layer c b -> Layer c a) -> Functor (Layer c)
forall a b. a -> Layer c b -> Layer c a
forall a b. (a -> b) -> Layer c a -> Layer c b
forall c a b. a -> Layer c b -> Layer c a
forall c a b. (a -> b) -> Layer c a -> Layer c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall c a b. (a -> b) -> Layer c a -> Layer c b
fmap :: forall a b. (a -> b) -> Layer c a -> Layer c b
$c<$ :: forall c a b. a -> Layer c b -> Layer c a
<$ :: forall a b. a -> Layer c b -> Layer c a
Functor, Functor (Layer c)
Functor (Layer c) =>
(forall a. a -> Layer c a)
-> (forall a b. Layer c (a -> b) -> Layer c a -> Layer c b)
-> (forall a b c.
    (a -> b -> c) -> Layer c a -> Layer c b -> Layer c c)
-> (forall a b. Layer c a -> Layer c b -> Layer c b)
-> (forall a b. Layer c a -> Layer c b -> Layer c a)
-> Applicative (Layer c)
forall c. Functor (Layer c)
forall a. a -> Layer c a
forall c a. a -> Layer c a
forall a b. Layer c a -> Layer c b -> Layer c a
forall a b. Layer c a -> Layer c b -> Layer c b
forall a b. Layer c (a -> b) -> Layer c a -> Layer c b
forall c a b. Layer c a -> Layer c b -> Layer c a
forall c a b. Layer c a -> Layer c b -> Layer c b
forall c a b. Layer c (a -> b) -> Layer c a -> Layer c b
forall a b c. (a -> b -> c) -> Layer c a -> Layer c b -> Layer c c
forall c a b c.
(a -> b -> c) -> Layer c a -> Layer c b -> Layer c c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall c a. a -> Layer c a
pure :: forall a. a -> Layer c a
$c<*> :: forall c a b. Layer c (a -> b) -> Layer c a -> Layer c b
<*> :: forall a b. Layer c (a -> b) -> Layer c a -> Layer c b
$cliftA2 :: forall c a b c.
(a -> b -> c) -> Layer c a -> Layer c b -> Layer c c
liftA2 :: forall a b c. (a -> b -> c) -> Layer c a -> Layer c b -> Layer c c
$c*> :: forall c a b. Layer c a -> Layer c b -> Layer c b
*> :: forall a b. Layer c a -> Layer c b -> Layer c b
$c<* :: forall c a b. Layer c a -> Layer c b -> Layer c a
<* :: forall a b. Layer c a -> Layer c b -> Layer c a
Applicative, Applicative (Layer c)
Applicative (Layer c) =>
(forall a b. Layer c a -> (a -> Layer c b) -> Layer c b)
-> (forall a b. Layer c a -> Layer c b -> Layer c b)
-> (forall a. a -> Layer c a)
-> Monad (Layer c)
forall c. Applicative (Layer c)
forall a. a -> Layer c a
forall c a. a -> Layer c a
forall a b. Layer c a -> Layer c b -> Layer c b
forall a b. Layer c a -> (a -> Layer c b) -> Layer c b
forall c a b. Layer c a -> Layer c b -> Layer c b
forall c a b. Layer c a -> (a -> Layer c b) -> Layer c b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall c a b. Layer c a -> (a -> Layer c b) -> Layer c b
>>= :: forall a b. Layer c a -> (a -> Layer c b) -> Layer c b
$c>> :: forall c a b. Layer c a -> Layer c b -> Layer c b
>> :: forall a b. Layer c a -> Layer c b -> Layer c b
$creturn :: forall c a. a -> Layer c a
return :: forall a. a -> Layer c a
Monad)


-- | A normal layer contributes to the size of the parent
layer :: View c () -> Layer c ()
layer :: forall c. View c () -> Layer c ()
layer = View c () -> Layer c ()
forall c a. View c a -> Layer c a
Layer


{- | This child of a 'stack' can pop out of the parent, covering content outside of it. Only usable inside 'stack'

> stack id $ do
>   layer id $ input (value "Autocomplete Box")
>   layer (popout (TRBL 50 0 0 0)) $ do
>     el_ "Item 1"
>     el_ "Item 2"
>     el_ "Item 3"
> el_ "This is covered by the menu"
-}
popout :: Mod c -> View c () -> Layer c () -- Sides Length -> Mod (Stack c)
popout :: forall c. Mod c -> View c () -> Layer c ()
popout Mod c
f View c ()
cnt = View c () -> Layer c ()
forall c a. View c a -> Layer c a
Layer (View c () -> Layer c ()) -> View c () -> Layer c ()
forall a b. (a -> b) -> a -> b
$ do
  Mod c -> View c () -> View c ()
forall c. Mod c -> View c () -> View c ()
el (Position -> Mod c
forall c. Position -> Mod c
position Position
Absolute Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Mod c
forall c. Int -> Mod c
zIndex Int
1 Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
f) View c ()
cnt


-- | Hide an element. See 'display'
hide :: Mod c
hide :: forall c. Mod c
hide = None -> Mod c
forall a c. (Style Display a, ToClassName a) => a -> Mod c
display None
None


-- | Set container to be a row. Favor 'Web.View.Layout.row' when possible
flexRow :: Mod c
flexRow :: forall c. Mod c
flexRow =
  Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$
    ClassName -> Class
cls ClassName
"row"
      Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"display" Text
"flex"
      Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"flex-direction" Text
"row"


-- | Set container to be a column. Favor 'Web.View.Layout.col' when possible
flexCol :: Mod c
flexCol :: forall c. Mod c
flexCol =
  Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$
    ClassName -> Class
cls ClassName
"col"
      Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"display" Text
"flex"
      Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"flex-direction" Text
"column"


-- | Cut off the contents of the element
truncate :: Mod c
truncate :: forall c. Mod c
truncate =
  Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$
    ClassName -> Class
cls ClassName
"truncate"
      Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"white-space" Text
"nowrap"
      Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"overflow" Text
"hidden"
      Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"text-overflow" Text
"ellipsis"