{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}

{-|

Purview aims to be pretty straightforward to work with.  As an example,
here's a counter that we'll then go through.

> module Main where
>
> import Purview
>
> incrementButton = onClick "increment" $ button [ text "+" ]
> decrementButton = onClick "decrement" $ button [ text "-" ]
>
> view count = div
>   [ p [ text ("count: " <> show count) ]
>   , incrementButton
>   , decrementButton
>   ]
>
> handler :: (Integer -> Purview String any IO) -> Purview () any IO
> handler = simpleHandler (0 :: Integer) reducer
>
> reducer action state = case action of
>   "increment" -> state + 1
>   "decrement" -> state - 1
>
> top = handler view
>
> main = run defaultConfiguration { component=top, devMode=True }

First we define two buttons, each which have action producers ('onClick').

When rendered, this tells Purview that when either is clicked it'd like to receive
a message ('increment' or 'decrement').

Then we define a handler, which takes an initial state ("0"), and a reducer.

The reducer defines how we're supposed to handle the events received, and it passes
down the new state to components.

Then we put it together ("handler view"), and run it.

Note the "devMode=True": this tells Purview to send the whole
tree over again when the websocket reconnects.  This is really handy
if you're re-running the server in ghci, although I really recommend
using ghcid so you can do:

> ghcid --command 'stack ghci yourProject/Main.hs' --test :main

Which will automatically restart the server on code changes.  It's fast!

For more in depth reading check out the [readme](https://github.com/purview-framework/purview/blob/main/README.md) and
the [examples](https://github.com/purview-framework/purview/tree/main/examples) folder.

-}

module Purview
  (
  -- ** Server
    run
  , Configuration (..)
  , defaultConfiguration

  -- ** Handlers
  -- | These are how you can catch events sent from things like 'onClick' and
  -- change state, or in the case of 'effectHandler', make API requests or call
  -- functions from your project.
  , simpleHandler
  , messageHandler
  , effectHandler

  -- ** HTML helpers
  , div
  , span
  , p
  , h1
  , h2
  , h3
  , h4
  , text
  , button
  , form
  , input
  , style

  -- ** Action producers
  , onClick
  , onSubmit

  -- ** For Testing
  , render

  -- ** AST
  , Attributes (..)
  , DirectedEvent (..)
  , Purview (..)
  )
where

import Prelude hiding (div, log, span)
import qualified Web.Scotty as Sc
import           Data.Text (pack, Text, all)
import qualified Data.Text.Lazy as LazyText
import qualified Network.Wai.Middleware.Gzip as Sc
import qualified Network.Wai.Handler.WebSockets as WaiWebSocket
import qualified Network.WebSockets as WebSocket
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import           Data.Aeson

import           Control.Monad (when)
import           Control.Concurrent.STM.TChan
import           Control.Monad.STM
import           Control.Concurrent

import           Component
import           EventLoop
import           Events
import           PrepareTree
import           Rendering
import           Wrapper
import Network.Wai.Middleware.RequestLogger (mkRequestLogger)

type Log m = String -> m ()

data Configuration parentAction action m = Configuration
  { forall parentAction action (m :: * -> *).
Configuration parentAction action m
-> Purview parentAction action m
component         :: Purview parentAction action m
  -- ^ The top level component to put on the page.
  , forall parentAction action (m :: * -> *).
Configuration parentAction action m -> m [Event] -> IO [Event]
interpreter       :: m [Event] -> IO [Event]
  -- ^ How to run your algebraic effects or other.  This will apply to all `effectHandler`s.
  , forall parentAction action (m :: * -> *).
Configuration parentAction action m -> String -> IO ()
logger            :: String -> IO ()
  -- ^ Specify what to do with logs
  , forall parentAction action (m :: * -> *).
Configuration parentAction action m -> [HtmlEventHandler]
htmlEventHandlers :: [HtmlEventHandler]
  -- ^ For extending the handled events.  Have a look at 'defaultConfiguration' to see
  -- how to make your own.
  , forall parentAction action (m :: * -> *).
Configuration parentAction action m -> Text
htmlHead          :: Text
  -- ^ This is placed directly into the \<head\>, so that you can link to external
  -- CSS etc
  , forall parentAction action (m :: * -> *).
Configuration parentAction action m -> Bool
devMode           :: Bool
  -- ^ When enabled, Purview will send the whole tree on websocket reconnection.
  -- This enables you to use
  -- "ghcid --command 'stack ghci examples/Main.hs' --test :main`"
  -- to restart the server on file change, and get a kind of live reloading
  }

defaultConfiguration :: Configuration parentAction action IO
defaultConfiguration :: forall parentAction action. Configuration parentAction action IO
defaultConfiguration = Configuration
  { $sel:component:Configuration :: Purview parentAction action IO
component         = [Purview parentAction action IO] -> Purview parentAction action IO
forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
div []
  , $sel:interpreter:Configuration :: IO [Event] -> IO [Event]
interpreter       = IO [Event] -> IO [Event]
forall a. a -> a
id
  , $sel:logger:Configuration :: String -> IO ()
logger            = String -> IO ()
forall a. Show a => a -> IO ()
print
  , $sel:htmlEventHandlers:Configuration :: [HtmlEventHandler]
htmlEventHandlers = [HtmlEventHandler
clickEventHandler, HtmlEventHandler
submitEventHandler]
  , $sel:htmlHead:Configuration :: Text
htmlHead          = Text
""
  , $sel:devMode:Configuration :: Bool
devMode           = Bool
False
  }

{-|

This starts up the Scotty server.  As a tiny example, to display some text saying "hello":

> import Purview
>
> view = p [ text "hello" ]
>
> main = run defaultConfiguration { component=view }

-}
run :: Monad m => Configuration () any m -> IO ()
run :: forall (m :: * -> *) any.
Monad m =>
Configuration () any m -> IO ()
run Configuration { Bool
devMode :: Bool
$sel:devMode:Configuration :: forall parentAction action (m :: * -> *).
Configuration parentAction action m -> Bool
devMode, Purview () any m
component :: Purview () any m
$sel:component:Configuration :: forall parentAction action (m :: * -> *).
Configuration parentAction action m
-> Purview parentAction action m
component, String -> IO ()
logger :: String -> IO ()
$sel:logger:Configuration :: forall parentAction action (m :: * -> *).
Configuration parentAction action m -> String -> IO ()
logger, m [Event] -> IO [Event]
interpreter :: m [Event] -> IO [Event]
$sel:interpreter:Configuration :: forall parentAction action (m :: * -> *).
Configuration parentAction action m -> m [Event] -> IO [Event]
interpreter, [HtmlEventHandler]
htmlEventHandlers :: [HtmlEventHandler]
$sel:htmlEventHandlers:Configuration :: forall parentAction action (m :: * -> *).
Configuration parentAction action m -> [HtmlEventHandler]
htmlEventHandlers, Text
htmlHead :: Text
$sel:htmlHead:Configuration :: forall parentAction action (m :: * -> *).
Configuration parentAction action m -> Text
htmlHead } = do
  let port :: Port
port = Port
8001
  let settings :: Settings
settings = Port -> Settings -> Settings
Warp.setPort Port
port Settings
Warp.defaultSettings
  Application
requestHandler' <- Purview () any m -> Text -> [HtmlEventHandler] -> IO Application
forall parentAction action (m :: * -> *).
Purview parentAction action m
-> Text -> [HtmlEventHandler] -> IO Application
requestHandler Purview () any m
component Text
htmlHead [HtmlEventHandler]
htmlEventHandlers
  Settings -> Application -> IO ()
Warp.runSettings Settings
settings
    (Application -> IO ()) -> Application -> IO ()
forall a b. (a -> b) -> a -> b
$ ConnectionOptions -> ServerApp -> Application -> Application
WaiWebSocket.websocketsOr
        ConnectionOptions
WebSocket.defaultConnectionOptions
        (Bool
-> (m [Event] -> IO [Event])
-> (String -> IO ())
-> Purview () any m
-> ServerApp
forall (m :: * -> *) parentAction action.
Monad m =>
Bool
-> (m [Event] -> IO [Event])
-> (String -> IO ())
-> Purview parentAction action m
-> ServerApp
webSocketHandler Bool
devMode m [Event] -> IO [Event]
interpreter String -> IO ()
logger Purview () any m
component)
        Application
requestHandler'

requestHandler :: Purview parentAction action m -> Text -> [HtmlEventHandler] -> IO Wai.Application
requestHandler :: forall parentAction action (m :: * -> *).
Purview parentAction action m
-> Text -> [HtmlEventHandler] -> IO Application
requestHandler Purview parentAction action m
routes Text
htmlHead [HtmlEventHandler]
htmlEventHandlers =
  ScottyM () -> IO Application
Sc.scottyApp (ScottyM () -> IO Application) -> ScottyM () -> IO Application
forall a b. (a -> b) -> a -> b
$ do
    (Application -> Application) -> ScottyM ()
Sc.middleware ((Application -> Application) -> ScottyM ())
-> (Application -> Application) -> ScottyM ()
forall a b. (a -> b) -> a -> b
$ GzipSettings -> Application -> Application
Sc.gzip (GzipSettings -> Application -> Application)
-> GzipSettings -> Application -> Application
forall a b. (a -> b) -> a -> b
$ GzipSettings
forall a. Default a => a
Sc.def { gzipFiles :: GzipFiles
Sc.gzipFiles = GzipFiles
Sc.GzipCompress }

    RoutePattern -> ActionM () -> ScottyM ()
Sc.get RoutePattern
"/"
      (ActionM () -> ScottyM ()) -> ActionM () -> ScottyM ()
forall a b. (a -> b) -> a -> b
$ Text -> ActionM ()
Sc.html
      (Text -> ActionM ()) -> Text -> ActionM ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
LazyText.fromStrict
      (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [HtmlEventHandler] -> Text -> Text
wrapHtml Text
htmlHead [HtmlEventHandler]
htmlEventHandlers
      (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Data.Text.pack
      (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Purview parentAction action m -> String
forall parentAction action (m :: * -> *).
Purview parentAction action m -> String
render (Purview parentAction action m -> String)
-> ((Purview parentAction action m, [Event])
    -> Purview parentAction action m)
-> (Purview parentAction action m, [Event])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Purview parentAction action m, [Event])
-> Purview parentAction action m
forall a b. (a, b) -> a
fst
      ((Purview parentAction action m, [Event]) -> String)
-> (Purview parentAction action m, [Event]) -> String
forall a b. (a -> b) -> a -> b
$ Purview parentAction action m
-> (Purview parentAction action m, [Event])
forall parentAction action (m :: * -> *).
Purview parentAction action m
-> (Purview parentAction action m, [Event])
prepareTree Purview parentAction action m
routes

webSocketMessageHandler :: TChan Event -> WebSocket.Connection -> IO ()
webSocketMessageHandler :: TChan Event -> Connection -> IO ()
webSocketMessageHandler TChan Event
eventBus Connection
websocketConnection = do
  ByteString
message' <- Connection -> IO ByteString
forall a. WebSocketsData a => Connection -> IO a
WebSocket.receiveData Connection
websocketConnection

  case ByteString -> Maybe Event
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
message' of
    Just Event
fromEvent -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan Event -> Event -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Event
eventBus Event
fromEvent
    Maybe Event
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  TChan Event -> Connection -> IO ()
webSocketMessageHandler TChan Event
eventBus Connection
websocketConnection

webSocketHandler
  :: Monad m
  => Bool
  -> (m [Event] -> IO [Event])
  -> Log IO
  -> Purview parentAction action m
  -> WebSocket.ServerApp
webSocketHandler :: forall (m :: * -> *) parentAction action.
Monad m =>
Bool
-> (m [Event] -> IO [Event])
-> (String -> IO ())
-> Purview parentAction action m
-> ServerApp
webSocketHandler Bool
devMode m [Event] -> IO [Event]
runner String -> IO ()
log Purview parentAction action m
component PendingConnection
pending = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
devMode (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"ws connected"
  Connection
conn <- PendingConnection -> IO Connection
WebSocket.acceptRequest PendingConnection
pending

  TChan Event
eventBus <- IO (TChan Event)
forall a. IO (TChan a)
newTChanIO

  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan Event -> Event -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Event
eventBus (Event -> STM ()) -> Event -> STM ()
forall a b. (a -> b) -> a -> b
$ Event { $sel:event:Event :: Text
event = Text
"init", $sel:message:Event :: Value
message = Value
"init", $sel:location:Event :: Maybe [Port]
location = Maybe [Port]
forall a. Maybe a
Nothing }

  Connection -> Port -> IO () -> IO () -> IO ()
forall a. Connection -> Port -> IO () -> IO a -> IO a
WebSocket.withPingThread Connection
conn Port
30 (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ TChan Event -> Connection -> IO ()
webSocketMessageHandler TChan Event
eventBus Connection
conn
    Bool
-> (m [Event] -> IO [Event])
-> (String -> IO ())
-> TChan Event
-> Connection
-> Purview parentAction action m
-> IO ()
forall (m :: * -> *) parentAction action.
Monad m =>
Bool
-> (m [Event] -> IO [Event])
-> (String -> IO ())
-> TChan Event
-> Connection
-> Purview parentAction action m
-> IO ()
eventLoop Bool
devMode m [Event] -> IO [Event]
runner String -> IO ()
log TChan Event
eventBus Connection
conn Purview parentAction action m
component