{- |
Module:      Web.Hyperbole
Copyright:   (c) 2024 Sean Hess
License:     BSD3
Maintainer:  Sean Hess <seanhess@gmail.com>
Stability:   experimental
Portability: portable

Create fully interactive HTML applications with type-safe serverside Haskell. Inspired by [HTMX](https://htmx.org/), [Elm](https://elm-lang.org/), and [Phoenix LiveView](https://www.phoenixframework.org/)
-}
module Web.Hyperbole
  ( -- * Introduction #intro#
    -- $use

    -- * Getting started #start#
    -- $hello

    -- ** HTML Views #views#
    -- $view-functions-intro

    -- ** Interactive HyperViews #hyperviews#
    -- $interactive

    -- ** View Functions #viewfunctions#
    -- $view-functions

    -- * Managing State #state#
    -- $state-parameters

    -- ** Side Effects #side-effects#
    -- $state-effects

    -- ** Databases and Custom Effects #databases#
    -- $state-databases

    -- * Multiple HyperViews #hyperview-multi#
    -- $practices-multi

    -- ** Same HyperView, Unique ViewId #hyperview-same#
    -- $practices-same

    -- ** Different HyperViews
    -- $practices-diff

    -- ** Nesting HyperViews #hyperview-nested#
    -- $practices-nested

    -- * Functions, not Components #reusable#
    -- $reusable

    -- * Pages and Routes #pages#
    -- $practices-pages

    -- * Examples #examples#
    -- $examples

    -- * Application #application#
    liveApp
  , Warp.run

    -- ** Page
  , Page
  , runPage

    -- ** Document
  , document
  , quickStartDocument
  , DocumentHead
  , quickStart
  , mobileFriendly

    -- ** Type-Safe Routes #routes#
  , Route (..)
  , routeRequest -- maybe belongs in an application section
  , routeUri
  , route

    -- * Hyperbole Effect #hyperbole-effect#
  , Hyperbole

    -- ** Request #request#
  , request
  , Request (..)

    -- ** Response #response#
  , respondError
  , respondErrorView
  , notFound
  , redirect

    -- ** Query #query#
    -- $query
  , ToQuery (..)
  , FromQuery (..)
  , query
  , setQuery
  , param
  , lookupParam
  , setParam
  , deleteParam
  , queryParams

    -- ** Sessions #sessions#
    -- $sessions
  , Session (..)
  , session
  , saveSession
  , lookupSession
  , modifySession
  , modifySession_
  , deleteSession

    -- ** Control Client #client#
  , pageTitle
  , trigger
  , pushEvent

    -- * HyperView #hyperview#
  , HyperView (..)
  , ViewId
  , ViewAction
  , hyper
  , HasViewId (..)

    -- * Interactive Elements #interactive#
  , button
  , search
  , dropdown
  , option
  , Option

    -- * Events
  , onClick
  , onDblClick
  , onMouseEnter
  , onMouseLeave
  , onInput
  , onLoad
  , DelayMs
  , onKeyDown
  , onKeyUp
  , Key (..)

    -- * Type-Safe Forms #forms#
    -- $forms
  , FromForm (..)
  , FromFormF (..)
  , formData
  , GenFields (..)
  , fieldNames
  , FieldName (..)
  , FormFields
  -- , FormField (..)
  , Field
  , Identity

    -- ** Form View
  , form
  , field
  , label
  , input
  , checkbox
  , radioGroup
  , radio
  , select
  , checked
  , textarea
  , submit
  , View.placeholder
  , InputType (..)

    -- ** Validation
  , Validated (..)
  , isInvalid
  , validate
  , invalidText

    -- * Query Param Encoding #query-param#
  , QueryData
  , ToParam (..)
  , FromParam (..)
  , ToEncoded
  , FromEncoded

    -- * Advanced #advanced#
  , target
  , Response
  , Root

    -- * Exports #exports#

    -- ** View
  , View (..)
  , module View

    -- ** Embeds

    -- | Embedded CSS and Javascript to include in your document function. See 'quickStartDocument'
  , module Web.Hyperbole.View.Embed

    -- ** Effectful
    -- $effects
  , module Effectful

    -- ** Other
  , URI (..)
  , uri
  , Application
  , module GHC.Generics
  , Default (..)
  , ToJSON
  , FromJSON
  ) where

import Data.Aeson (FromJSON, ToJSON)
import Data.Default
import Effectful (Eff, (:>))
import GHC.Generics (Generic, Rep)
import Network.Wai (Application)
import Network.Wai.Handler.Warp as Warp (run)
import Web.Atomic.CSS ()
import Web.Atomic.Types ()
import Web.Hyperbole.Application
import Web.Hyperbole.Data.Encoded (FromEncoded, ToEncoded)
import Web.Hyperbole.Data.Param
import Web.Hyperbole.Data.QueryData
import Web.Hyperbole.Document
import Web.Hyperbole.Effect.Client
import Web.Hyperbole.Effect.Hyperbole
import Web.Hyperbole.Effect.Query
import Web.Hyperbole.Effect.Request
import Web.Hyperbole.Effect.Response
import Web.Hyperbole.Effect.Session
import Web.Hyperbole.HyperView
import Web.Hyperbole.HyperView.Forms
import Web.Hyperbole.Page (Page, runPage)
import Web.Hyperbole.Route
import Web.Hyperbole.Types.Request
import Web.Hyperbole.Types.Response
import Web.Hyperbole.View hiding (placeholder)
import Web.Hyperbole.View qualified as View hiding (Attributable, Attributes, View)
import Web.Hyperbole.View.Embed


{- $use

Single Page Applications (SPAs) require the programmer to write two programs: a Javascript client and a Server, which both must conform to a common API

Hyperbole allows us to instead write a single Haskell program which runs exclusively on the server. All user interactions are sent to the server for processing, and a sub-section of the page is updated with the resulting HTML.

There are frameworks that support this in different ways, including [HTMX](https://htmx.org/), [Phoenix LiveView](https://www.phoenixframework.org/), and others. Hyperbole has the following advantages

1. 100% Haskell
2. Type safe views, actions, routes, and forms
3. Elegant interface with little boilerplate
4. VirtualDOM updates over sockets, fallback to HTTP
5. Easy to use

Like [HTMX](https://htmx.org/), Hyperbole extends the capability of UI elements, but it uses Haskell's type-system to prevent common errors and provide default functionality. Specifically, a page has multiple update targets called 'HyperView's. These are automatically targeted by any UI element that triggers an action inside them. The compiler makes sure that actions and targets match

Like [Phoenix LiveView](https://www.phoenixframework.org/), it upgrades the page to a fast WebSocket connection and uses VirtualDOM for live updates

Like [Elm](https://elm-lang.org/), it uses an update function to process actions, but greatly simplifies the Elm Architecture by remaining stateless. Effects are handled by [Effectful](https://hackage.haskell.org/package/effectful). 'form's are easy to use with minimal boilerplate

Hyperbole depends heavily on the following frameworks

* [Effectful](https://hackage.haskell.org/package/effectful-core)
* [Atomic CSS](https://hackage.haskell.org/package/atomic-css)
-}


{- $hello

▶️ [Intro](https://hyperbole.live/intro)

Hyperbole applications run via [Warp](https://hackage.haskell.org/package/warp) and [WAI](https://hackage.haskell.org/package/wai)

They are divided into top-level 'Page's, which run side effects (such as loading data from a database), then respond with an HTML 'View'. The following application has a single 'Page' that displays a static "Hello World"

@
{\-# LANGUAGE OverloadedStrings #-\}

module Main where

import Web.Hyperbole

main :: IO ()
main = do
  'run' 3000 $ do
    'liveApp' 'quickStartDocument' ('runPage' page)

page :: 'Page' es '[]
page = do
  pure $ 'el' \"Hello World\"
@
-}


{- $interactive

▶️ [Simple](https://hyperbole.live/simple)

We can embed one or more 'HyperView's to add type-safe interactivity to live subsections of our 'Page'. To start, first define a data type (a 'ViewId') that uniquely identifies that subsection of the page:

@
data Message = Message
  deriving (Generic, 'ViewId')
@

Make our 'ViewId' an instance of 'HyperView':

* Create an 'Action' type with a constructor for every possible way that the user can interact with it
* Write an 'update' for each 'Action'

@
instance 'HyperView' Message es where
  data 'Action' Message
    = SetMessage Text
    deriving (Generic, 'ViewAction')

  'update' (SetMessage msg) =
    pure $ messageView msg
@

If an 'Action' occurs, the contents of our 'HyperView' will be replaced with the result of 'update'.

To use our new 'HyperView', add the 'ViewId' to the type-level list of 'Page', and then place it in the page view with 'hyper'.

@
page :: 'Page' es '[Message]
page = do
  pure $ do
    'el' \"Unchanging Header\"
    'hyper' Message $ messageView \"Hello World\"
@

Now let's add a button to trigger the 'Action'. Note that we must now update the 'View'\'s 'context' to match our 'ViewId'. The compiler will tell us if we try to trigger actions that don't belong to our 'HyperView'

@
messageView :: Text -> 'View' Message ()
messageView msg = do
  'el' ~ bold $ text msg
  'button' (SetMessage \"Goodbye\") \"Say Goodbye\"
@

If the user clicks the button, the contents of `hyper` will be replaced with the result of 'update', leaving the rest of the page untouched.
-}


{- $view-functions-intro

'View's are HTML fragments with a 'context'

@
helloWorld :: 'View' context ()
helloWorld =
  'el' \"Hello World\"
@

>>> renderText helloWorld
<div>Hello World</div>

We can factor 'View's into reusable functions:

▶️ [Simple](https://hyperbole.live/simple)

@
messageView :: Text -> 'View' context ()
messageView msg =
  'el' $ text msg

page' :: 'Page' es '[]
page' = do
  pure $ messageView \"Hello World\"
@

Using [atomic-css](https://hackage.haskell.org/package/atomic-css) we can use functions to factor styles as well

▶️ [CSS](https://hyperbole.live/css)

@
import Web.Atomic.CSS

header = bold
h1 = header . fontSize 32
h2 = header . fontSize 24
page = gap 10

example = col page $ do
  el h1 "My Page"
@
-}


{- $view-functions

We showed above how we can factor 'View's into functions. It's best-practice to have a main 'View' function for each 'HyperView'. These take the form:

> state -> View viewId ()

There's nothing special about `state` or 'View' functions. They're just functions that take input data and return a view.

We can write multiple view functions with our 'HyperView' as the 'context', and factor them however is most convenient:

@
messageButton :: Text -> 'View' Message ()
messageButton msg = do
  'button' (SetMessage msg) ~ border 1 $ text $ \"Say \" <> msg
@

Some 'View' functions can be used in any 'context':

@
header :: Text -> 'View' ctx ()
header txt = do
  'el' ~ bold $ text txt
@

With those two functions defined, we can refactor our main 'View' to use them and avoid repeating ourselves

@
messageView :: Text -> 'View' Message ()
messageView m = do
  header m
  messageButton \"Salutations!\"
  messageButton \"Good Morning!\"
  messageButton \"Goodbye\"
@
-}


{- $practices

We've mentioned most of the Architecture of a hyperbole application, but let's go over each layer here:

* [Pages](#g:pages) - routes map to completely independent web pages
* [HyperViews](#g:hyperviews) - independently updating live subsections of a 'Page'
* Main [View Functions](#g:viewfunctions) - A view function that renders and updates a 'HyperView'
* [Reusable View Functions](#g:reusable) - Generic view functions you can use in any 'HyperView'
-}


{- $practices-multi

We can add as many 'HyperView's to a page as we want. These can be muliple copies of the same 'HyperView' with unique 'ViewId' values, or completely different 'HyperView's.
-}


{- $practices-diff

Let's add both 'Count' and 'Message' 'HyperView's to the same page. Each will update independently:

@
page :: 'Page' es [Message, Count]
page = do
  pure $ do
    'hyper' Message $ messageView \"Hello\"
    'hyper' Count $ countView 0
@
-}


{- $practices-same

We can embed more than one of the same 'HyperView' as long as the value of 'ViewId' is unique. Let's update `Message` to allow for more than one value:

▶️ [Simple](https://hyperbole.live/simple)

@
data Message = Message1 | Message2
  deriving (Generic, 'ViewId')
@

Now we can embed multiple `Message` 'HyperView's into the same page. Each will update independently.

@
page :: 'Page' es '[Message]
page = do
  pure $ do
    'hyper' Message1 $ messageView \"Hello\"
    'hyper' Message2 $ messageView \"World!\"
@


This is especially useful if we put identifying information in our 'ViewId', such as a database id. The 'viewId' function can give us access to that info:

▶️ [Load More](https://hyperbole.live/data/loadmore)

@
data Languages = Languages Offset
  deriving (Generic, 'ViewId')

instance 'HyperView' Languages es where
  data 'Action' Languages
    = Load
    deriving (Generic, 'ViewAction')

  'update' Load = do
    Languages offset <- 'viewId'
    ls <- loadNextLanguages offset
    pure $ languagesView ls
@
-}


{- $practices-pages

An app will usually have multiple 'Page's with different 'Route's that each map to a unique url path:

@
data AppRoute
  = Message -- /message
  | Counter -- /counter
  deriving (Generic, Eq, 'Route')
@

When we create our app, we can add a router function which maps a 'Route' to a 'Page' with 'routeRequest'. The web page is completely reloaded each time you switch routes. Each 'Page' is completely isolated.

@
main = do
  'run' 3000 $ do
    'liveApp' 'quickStartDocument' ('routeRequest' router)
 where
  router Message = 'runPage' Message.page
  router Counter = 'runPage' Counter.page
@

We can add type-safe links to other pages using 'route'

@
menu :: 'View' c ()
menu = do
  'route' Message \"Link to /message\"
  'route' Counter \"Link to /counter\"
@

If you need the same header or menu on all pages, use a view function:

@
exampleLayout :: 'View' c () -> 'View' c ()
exampleLayout contents = do
  col ~ grow $ do
    'el' ~ border 1 $ \"My Website Header\"
    row $ do
      menu
      contents

examplePage :: 'Page' es '[]
examplePage = do
  pure $ exampleLayout $ do
    'el' \"page contents\"
@

As shown above, each 'Page' can contain multiple interactive 'HyperView's to add interactivity
-}


{- $practices-nested

We can nest smaller, more specific 'HyperView's inside of a larger parent. You might need this technique to display a list of items which might also need to update themselves individually

Let's imagine we want to display a list of Todos. The user can mark individual todos complete, and have them update independently. The more specific 'HyperView' for each item might look like this:

▶️ [TodoMVC](https://hyperbole.live/examples/todos)

@
data TodoItem = TodoItem
  deriving (Generic, 'ViewId')

instance 'HyperView' TodoItem es where
  data 'Action' TodoItem
    = Complete Todo
    deriving (Generic, 'ViewAction')

  'update' (Complete todo) = do
    let new = todo{completed = True}
    pure $ todoView new
@

But we also want the entire list to refresh when a user adds a new todo. We need to create a parent 'HyperView' for the whole list.

Add any nested 'HyperView's to 'Require' to make sure they are handled. The compiler will let you know if you forget

@
data AllTodos = AllTodos
  deriving (Generic, 'ViewId')

instance 'HyperView' AllTodos es where
  type Require AllTodos = '[TodoItem]

  data 'Action' AllTodos
    = AddTodo Text [Todo]
    deriving (Generic, 'ViewAction')

  'update' (AddTodo txt todos) = do
    let new = Todo txt False : todos
    pure $ todosView new
@

Then we can embed the child 'HyperView' into the parent 'View' just like we do on a 'Page', by using 'hyper'

@
todosView :: [Todo] -> 'View' AllTodos ()
todosView todos = do
  forM_ todos $ \todo -> do
    'hyper' TodoItem $ todoView todo
  'button' (AddTodo \"Shopping\" todos) \"Add Todo: Shopping\"
@
-}


{- $reusable

You may be tempted to use 'HyperView's to create reusable \"Components\". This leads to object-oriented designs that don't compose well. We are using a functional language, so our main unit of reuse should be functions!

We showed earlier that we can write a [View Function](#g:view-functions) with a generic 'context' that we can reuse in any view.  A function like this might help us reuse styles or layout:

@
header :: Text -> 'View' ctx ()
header txt = do
  'el' ~ bold $ text txt
@

But what if we want to reuse interactivity? We can pass an 'Action' into the view function as a parameter:

@
styledButton :: ('ViewAction' ('Action' id)) => 'Action' id -> Text -> 'View' id ()
styledButton clickAction lbl = do
  'button' clickAction ~ btn $ text lbl
 where
  btn = pad 10 . bg Primary . hover (bg PrimaryLight) . rounded 5
@

We can create more complex view functions by passing state in as a parameter. Here's a button that toggles between a checked and unchecked state for any 'HyperView':

@
toggleCheckbox :: ('ViewAction' ('Action' id)) => (Bool -> 'Action' id) -> Bool -> 'View' id ()
toggleCheckbox setChecked isSelected = do
  tag \"input\" @ att \"type\" \"checkbox\" . onClick (setChecked (not isSelected)) . checked isSelected ~ big $ none
 where
  big = width 32 . height 32
@

View functions can be containers which wrap other Views:

@
progressBar :: Float -> 'View' context () -> 'View' context ()
progressBar pct contents = do
  row ~ bg Light $ do
    row ~ bg PrimaryLight . width (Pct pct) . pad 5 $ contents
@


Don't use 'HyperView's to keep your code DRY. Think about which subsections of a page ought to update independently. Those are 'HyperView's. If you need reusable interactivity, use [view functions](#g:viewfunctions) whenever possible. See the following example for a more complicated example.

▶️ [Sortable Table](https://hyperbole.live/data/sortabletable)
-}


{- $examples
[hyperbole.live](https://hyperbole.live) is full of live examples demonstrating different features. Each example includes a link to the source code. Some highlights:

* ▶️ [Simple](https://hyperbole.live/simple)
* ▶️ [Counter](https://hyperbole.live/counter)
* ▶️ [Concurrency](https://hyperbole.live/concurrency)
* ▶️ [State](https://hyperbole.live/state)
* ▶️ [Requests](https://hyperbole.live/requests)
* ▶️ [Data Lists](https://hyperbole.live/data)
* ▶️ [Forms](https://hyperbole.live/forms)
* ▶️ [Interactivity](https://hyperbole.live/interactivity)
* ▶️ [Error Handling](https://hyperbole.live/errors)
* ▶️ [OAuth2](https://hyperbole.live/oauth2)
* ▶️ [Javascript](https://hyperbole.live/javascript)
* ▶️ [Advanced](https://hyperbole.live/advanced)

The [National Solar Observatory](https://nso.edu) uses Hyperbole to manage Level 2 Data pipelines for the [DKIST telescope](https://nso.edu/telescopes/dki-solar-telescope/). It uses complex user interfaces, workers, databases, and more. [The entire codebase is open source](https://github.com/DKISTDC/level2/).
-}


{- $state-parameters

'HyperView's are stateless. They 'update' based entirely on the 'Action'. However, we can track simple state by passing it back and forth between the 'Action' and the 'View'

▶️ [Counter](https://hyperbole.live/counter)

@
instance 'HyperView' Counter es where
  data 'Action' Counter
    = Increment Int
    | Decrement Int
    deriving (Generic, 'ViewAction')

  'update' (Increment n) = do
    pure $ viewCount (n + 1)
  'update' (Decrement n) = do
    pure $ viewCount (n - 1)

viewCount :: Int -> 'View' Counter ()
viewCount n = row $ do
  col ~ gap 10 $ do
    'el' ~ dataFeature $ text $ pack $ show n
    row ~ gap 10 $ do
      'button' (Decrement n) \"Decrement\" ~ Style.btn
      'button' (Increment n) \"Increment\" ~ Style.btn
@
-}


{- $state-effects

For any real application with more complex state and data persistence, we need side effects.

Hyperbole relies on [Effectful](https://hackage.haskell.org/package/effectful) to compose side effects. We can use effects in a 'Page' or an 'update'. The 'Hyperbole' effect gives us access to the 'request' and client state, including 'session's and the 'query' 'param's. In this example the page keeps the message in the 'query' 'param's

▶️ [Query](https://hyperbole.live/state/query)

@
page :: ('Hyperbole' :> es) => 'Page' es '[Message]
page = do
  prm <- 'lookupParam' \"msg\"
  let msg = fromMaybe \"hello\" prm
  pure $ do
    'hyper' Message $ messageView msg

instance 'HyperView' Message es where
  data 'Action' Message
    = Louder Text
    deriving (Generic, 'ViewAction')

  'update' (Louder msg) = do
    let new = msg <> \"!\"
    'setParam' \"msg\" new
    pure $ messageView new
@


To use an 'Effect' other than 'Hyperbole', add it as a constraint to the 'Page' and any 'HyperView' instances that need it.

▶️ [Effects](https://hyperbole.live/state/effects)

@
{\-# LANGUAGE UndecidableInstances #-\}

instance (Reader (TVar Int) :> es, Concurrent :> es) => 'HyperView' Counter es where
  data 'Action' Counter
    = Increment
    | Decrement
    deriving (Generic, 'ViewAction')

  'update' Increment = do
    n <- modify (+ 1)
    pure $ viewCount n
  'update' Decrement = do
    n <- modify (subtract 1)
    pure $ viewCount n
@

Then run the effect in your application

@
app :: TVar Int -> Application
app var = do
  'liveApp' 'quickStartDocument' (runReader var . runConcurrent $ 'runPage' page)
@

See [Effectful](https://hackage.haskell.org/package/effectful) to read more about Effects
-}


{- $state-databases

A database is no different from any other 'Effect'. It is recommended to create a custom effect to describe high-level data operations.

▶️ [TodoMVC](https://hyperbole.live/examples/todos)

@
data Todos :: Effect where
  LoadAll :: Todos m [Todo]
  Save :: Todo -> Todos m ()
  Remove :: TodoId -> Todos m ()
  Create :: Text -> Todos m TodoId

loadAll :: (Todos :> es) => 'Eff' es [Todo]
loadAll = send LoadAll
@

Just like any effect, to use our custom 'Effect', we add it to any 'HyperView' or 'Page' as a constraint.

@
{\-# LANGUAGE UndecidableInstances #-\}

simplePage :: (Todos :> es) => 'Page' es '[AllTodos, TodoView]
simplePage = do
  todos <- Todos.loadAll
  pure $ do
    'hyper' AllTodos $ todosView FilterAll todos
@

We run a custom effect in our Application just like any other. The TodoMVC example implements the Todos 'Effect' using 'Hyperbole' 'sessions', but you could write a different runner that connects to a database instead.

@
main :: IO ()
main = do
  'run' 3000 $ do
    'liveApp' 'quickStartDocument' (runTodosSession $ 'runPage' simplePage)
@

Implementing a database runner for a custom 'Effect' is beyond the scope of this documentation, but see the following:

* [Effectful.Dynamic.Dispatch](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Dynamic.html) - Introduction to Effects
* [NSO.Data.Datasets](https://github.com/DKISTDC/level2/blob/main/src/NSO/Data/Datasets.hs) - Production Data Effect with a database runner
* [Effectful.Rel8](https://github.com/DKISTDC/level2/blob/main/types/src/Effectful/Rel8.hs) - Effect for the [Rel8](https://hackage.haskell.org/package/rel8) Postgres Library
-}


{- $query
▶️ [Query](https://hyperbole.live/state/query)
-}


{- $sessions
▶️ [Sessions](https://hyperbole.live/state/sessions)
-}


{- $forms

Painless forms with type-checked field names, and support for validation.

▶️ [Forms](https://hyperbole.live/forms)
-}