{-# LANGUAGE DataKinds #-}

module Web.View.Element where

import Control.Monad (forM_)
import Data.Function ((&))
import Data.Text (Text)
import Effectful
import Effectful.Writer.Static.Local
import Web.View.Style
import Web.View.Types
import Web.View.Types.Url
import Web.View.View


{- | A basic element

> el (bold . pad 10) "Hello"
-}
el :: Mod c -> View c () -> View c ()
el :: forall c. Mod c -> View c () -> View c ()
el = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"div"


{- | A basic element, with no modifiers

> el_ "Hello"
-}
el_ :: View c () -> View c ()
el_ :: forall c. View c () -> View c ()
el_ = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"div" Mod c
forall a. a -> a
id


{- | Add text to a view. Not required for string literals

> el_ $ do
>   "Hello: "
>   text user.name
-}
text :: Text -> View c ()
text :: forall c. Text -> View c ()
text Text
t = Content -> View c ()
forall c. Content -> View c ()
viewAddContent (Content -> View c ()) -> Content -> View c ()
forall a b. (a -> b) -> a -> b
$ Text -> Content
Text Text
t


{- | Embed static, unescaped HTML or SVG. Take care not to use 'raw' with user-generated content.

> spinner = raw "<svg>...</svg>"
-}
raw :: Text -> View c ()
raw :: forall c. Text -> View c ()
raw Text
t = Content -> View c ()
forall c. Content -> View c ()
viewAddContent (Content -> View c ()) -> Content -> View c ()
forall a b. (a -> b) -> a -> b
$ Text -> Content
Raw Text
t


{- | Do not show any content

> if isVisible
>  then content
>  else none
-}
none :: View c ()
none :: forall c. View c ()
none = () -> View c ()
forall a. a -> View c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


pre :: Mod c -> Text -> View c ()
pre :: forall c. Mod c -> Text -> View c ()
pre Mod c
f Text
t = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"pre" Mod c
f (Text -> View c ()
forall c. Text -> View c ()
text Text
t)


-- | A hyperlink to the given url
link :: Url -> Mod c -> View c () -> View c ()
link :: forall c. Url -> Mod c -> View c () -> View c ()
link Url
u Mod c
f = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"a" (Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"href" (Url -> Text
renderUrl Url
u) Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod c
f)


-- * Inputs


form :: Mod c -> View c () -> View c ()
form :: forall c. Mod c -> View c () -> View c ()
form Mod c
f = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"form" (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)


input :: Mod c -> View c ()
input :: forall c. Mod c -> View c ()
input Mod c
m = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"input" (Mod c
m Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"type" Text
"text") View c ()
forall c. View c ()
none


name :: Text -> Mod c
name :: forall c. Text -> Mod c
name = Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"name"


value :: Text -> Mod c
value :: forall c. Text -> Mod c
value = Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"value"


label :: Mod c -> View c () -> View c ()
label :: forall c. Mod c -> View c () -> View c ()
label = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"label"


button :: Mod c -> View c () -> View c ()
button :: forall c. Mod c -> View c () -> View c ()
button = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"button"


-- * Document Metadata


script :: Text -> View c ()
script :: forall c. Text -> View c ()
script Text
src = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"script" (Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"type" Text
"text/javascript" Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"src" Text
src) View c ()
forall c. View c ()
none


style :: Text -> View c ()
style :: forall c. Text -> View c ()
style Text
cnt = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"style" (Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"type" Text
"text/css") (Text -> View c ()
forall c. Text -> View c ()
text (Text -> View c ()) -> Text -> View c ()
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cnt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")


stylesheet :: Text -> View c ()
stylesheet :: forall c. Text -> View c ()
stylesheet Text
href = Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"link" (Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"rel" Text
"stylesheet" Mod c -> Mod c -> Mod c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Mod c
forall c. Text -> Text -> Mod c
att Text
"href" Text
href) View c ()
forall c. View c ()
none


-- * Tables


{- | Create a type safe data table by specifying columns

> usersTable :: [User] -> View c ()
> usersTable us = do
>   table id us $ do
>     tcol (th hd "Name") $ \u -> td cell $ text u.name
>     tcol (th hd "Email") $ \u -> td cell $ text u.email
>  where
>   hd = cell . bold
>   cell = pad 4 . border 1
-}
table :: Mod c -> [dt] -> Eff '[Writer [TableColumn c dt]] () -> View c ()
table :: forall c dt.
Mod c -> [dt] -> Eff '[Writer [TableColumn c dt]] () -> View c ()
table Mod c
f [dt]
dts Eff '[Writer [TableColumn c dt]] ()
wcs = do
  c
c <- View c c
forall context. View context context
context
  let cols :: [TableColumn c dt]
cols = Eff '[] [TableColumn c dt] -> [TableColumn c dt]
forall a. HasCallStack => Eff '[] a -> a
runPureEff (Eff '[] [TableColumn c dt] -> [TableColumn c dt])
-> (Eff '[Writer [TableColumn c dt]] ()
    -> Eff '[] [TableColumn c dt])
-> Eff '[Writer [TableColumn c dt]] ()
-> [TableColumn c dt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[Writer [TableColumn c dt]] () -> Eff '[] [TableColumn c dt]
forall w (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es w
execWriter (Eff '[Writer [TableColumn c dt]] () -> [TableColumn c dt])
-> Eff '[Writer [TableColumn c dt]] () -> [TableColumn c dt]
forall a b. (a -> b) -> a -> b
$ Eff '[Writer [TableColumn c dt]] ()
wcs
  Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"table" Mod c
forall c. Mod c
borderCollapse (View c () -> View c ()) -> View c () -> View c ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"thead" Mod c
forall a. a -> a
id (View c () -> View c ()) -> View c () -> View c ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"tr" Mod c
f (View c () -> View c ()) -> View c () -> View c ()
forall a b. (a -> b) -> a -> b
$ do
        [TableColumn c dt] -> (TableColumn c dt -> View c ()) -> View c ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TableColumn c dt]
cols ((TableColumn c dt -> View c ()) -> View c ())
-> (TableColumn c dt -> View c ()) -> View c ()
forall a b. (a -> b) -> a -> b
$ \TableColumn c dt
tc -> do
          TableHead c -> View (TableHead c) () -> View c ()
forall context c. context -> View context () -> View c ()
addContext (c -> TableHead c
forall a. a -> TableHead a
TableHead c
c) TableColumn c dt
tc.headCell
    Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"tbody" Mod c
forall a. a -> a
id (View c () -> View c ()) -> View c () -> View c ()
forall a b. (a -> b) -> a -> b
$ do
      [dt] -> (dt -> View c ()) -> View c ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [dt]
dts ((dt -> View c ()) -> View c ()) -> (dt -> View c ()) -> View c ()
forall a b. (a -> b) -> a -> b
$ \dt
dt -> do
        Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"tr" Mod c
f (View c () -> View c ()) -> View c () -> View c ()
forall a b. (a -> b) -> a -> b
$ do
          [TableColumn c dt] -> (TableColumn c dt -> View c ()) -> View c ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TableColumn c dt]
cols ((TableColumn c dt -> View c ()) -> View c ())
-> (TableColumn c dt -> View c ()) -> View c ()
forall a b. (a -> b) -> a -> b
$ \TableColumn c dt
tc -> do
            dt -> View dt () -> View c ()
forall context c. context -> View context () -> View c ()
addContext dt
dt (View dt () -> View c ()) -> View dt () -> View c ()
forall a b. (a -> b) -> a -> b
$ TableColumn c dt
tc.dataCell dt
dt
 where
  borderCollapse :: Mod c
  borderCollapse :: forall c. Mod c
borderCollapse = 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
"brd-cl" Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @Text Text
"border-collapse" Text
"collapse"


tcol :: forall dt c. View (TableHead c) () -> (dt -> View dt ()) -> Eff '[Writer [TableColumn c dt]] ()
tcol :: forall dt c.
View (TableHead c) ()
-> (dt -> View dt ()) -> Eff '[Writer [TableColumn c dt]] ()
tcol View (TableHead c) ()
hd dt -> View dt ()
view = do
  [TableColumn c dt] -> Eff '[Writer [TableColumn c dt]] ()
forall w (es :: [(* -> *) -> * -> *]).
(HasCallStack, Writer w :> es, Monoid w) =>
w -> Eff es ()
tell ([View (TableHead c) () -> (dt -> View dt ()) -> TableColumn c dt
forall c dt.
View (TableHead c) () -> (dt -> View dt ()) -> TableColumn c dt
TableColumn View (TableHead c) ()
hd dt -> View dt ()
view] :: [TableColumn c dt])


th :: Mod c -> View c () -> View (TableHead c) ()
th :: forall c. Mod c -> View c () -> View (TableHead c) ()
th Mod c
f View c ()
cnt = do
  TableHead c
c <- View (TableHead c) (TableHead c)
forall context. View context context
context
  c -> View c () -> View (TableHead c) ()
forall context c. context -> View context () -> View c ()
addContext c
c (View c () -> View (TableHead c) ())
-> View c () -> View (TableHead c) ()
forall a b. (a -> b) -> a -> b
$ Text -> Mod c -> View c () -> View c ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"th" Mod c
f View c ()
cnt


td :: Mod () -> View () () -> View dt ()
td :: forall dt. Mod () -> View () () -> View dt ()
td Mod ()
f View () ()
c = () -> View () () -> View dt ()
forall context c. context -> View context () -> View c ()
addContext () (View () () -> View dt ()) -> View () () -> View dt ()
forall a b. (a -> b) -> a -> b
$ Text -> Mod () -> View () () -> View () ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"td" Mod ()
f View () ()
c


newtype TableHead a = TableHead a


data TableColumn c dt = TableColumn
  { forall c dt. TableColumn c dt -> View (TableHead c) ()
headCell :: View (TableHead c) ()
  , forall c dt. TableColumn c dt -> dt -> View dt ()
dataCell :: dt -> View dt ()
  }