module ComponentHelpers where

import           Data.Typeable
import           Data.Bifunctor

import           Events
import           Component (Purview (..), Attributes (..))

{-|

This is the pure handler, for when you don't need access to IO.  Events
are still handled within a green thread so it's possible to overwrite
state, just something to be aware of.

__Example__:

Let's say you want to make a button that switches between saying
"up" or "down":

@
view direction = onClick "toggle" $ button [ text direction ]

toggleHandler = handler [] "up" reducer
  where reducer "toggle" state =
          let newState = if state == "up" then "down" else "up"
          in (const newState, [])

component = toggleHandler view
@

Or typed out in longer form:

@
type State = String
type Event = String

reducer :: Event -> State -> (State -> State, [DirectedEvent parentEvent Event])
reducer event state = case event of
  "up"   -> (const "down", [])
  "down" -> (const "up", [])

toggleHandler :: (State -> Purview Event m) -> Purview parentEvent m
toggleHandler = handler [] "up" reducer

component :: Purview parentEvent m
component = toggleHandler view
@

Note that parentEvent is left unspecified as this handler doesn't send
any events to a parent, so it can be plugged in anywhere.  If you did
want to send events, the reducer looks like this:

@
reducer :: String -> String -> (String -> String, [DirectedEvent String String])
reducer event state = case event of
  "up"   -> (const "down", [Self "down"])
  "down" -> (const "up", [Parent "clickedDown"])
@

Which is about all there is to sending more events.
-}
handler
  :: ( Typeable event
     , Show state
     , Eq state
     , Typeable state
     )
  => [DirectedEvent parentEvent event]
  -- ^ Initial events to fire
  -> state
  -- ^ The initial state
  -> (event -> state -> (state -> state, [DirectedEvent parentEvent event]))
  -- ^ The reducer, or how the state should change for an event
  -> (state -> Purview event m)
  -- ^ The continuation / component to connect to
  -> Purview parentEvent m
handler :: forall event state parentEvent (m :: * -> *).
(Typeable event, Show state, Eq state, Typeable state) =>
[DirectedEvent parentEvent event]
-> state
-> (event
    -> state -> (state -> state, [DirectedEvent parentEvent event]))
-> (state -> Purview event m)
-> Purview parentEvent m
handler [DirectedEvent parentEvent event]
initEvents state
state event
-> state -> (state -> state, [DirectedEvent parentEvent event])
reducer state -> Purview event m
cont =
  forall state newEvent event (m :: * -> *).
(Show state, Eq state, Typeable state, Typeable newEvent) =>
ParentIdentifier
-> ParentIdentifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
    -> state -> (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
Handler forall a. Maybe a
Nothing forall a. Maybe a
Nothing [DirectedEvent parentEvent event]
initEvents state
state event
-> state -> (state -> state, [DirectedEvent parentEvent event])
reducer state -> Purview event m
cont

{-|

This provides a shorthand for when you know you want to overwrite
the state on each event.

__Example__:

@
view direction = onClick "toggle" $ button [ text direction ]

toggleHandler = handler' [] "up" reducer
  where reducer "toggle" state =
          let newState = if state == "up" then "down" else "up"
          -- note it's just newState, not const newState
          in (newState, [])

component = toggleHandler view
-}
handler'
  :: ( Typeable event
     , Show state
     , Eq state
     , Typeable state
     )
  => [DirectedEvent parentEvent event]
  -- ^ Initial events to fire
  -> state
  -- ^ The initial state
  -> (event -> state -> (state, [DirectedEvent parentEvent event]))
  -- ^ The reducer, or how the state should change for an event
  -> (state -> Purview event m)
  -- ^ The continuation / component to connect to
  -> Purview parentEvent m
handler' :: forall event state parentEvent (m :: * -> *).
(Typeable event, Show state, Eq state, Typeable state) =>
[DirectedEvent parentEvent event]
-> state
-> (event -> state -> (state, [DirectedEvent parentEvent event]))
-> (state -> Purview event m)
-> Purview parentEvent m
handler' [DirectedEvent parentEvent event]
initEvents state
state event -> state -> (state, [DirectedEvent parentEvent event])
reducer state -> Purview event m
cont =
  forall state newEvent event (m :: * -> *).
(Show state, Eq state, Typeable state, Typeable newEvent) =>
ParentIdentifier
-> ParentIdentifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
    -> state -> (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
Handler forall a. Maybe a
Nothing forall a. Maybe a
Nothing [DirectedEvent parentEvent event]
initEvents state
state (forall {p} {p} {a} {b} {b}.
(p -> p -> (a, b)) -> p -> p -> (b -> a, b)
constReducer event -> state -> (state, [DirectedEvent parentEvent event])
reducer) state -> Purview event m
cont
  where constReducer :: (p -> p -> (a, b)) -> p -> p -> (b -> a, b)
constReducer p -> p -> (a, b)
reducer p
event p
state =
          let (a
newState, b
events) = p -> p -> (a, b)
reducer p
event p
state
          in (forall a b. a -> b -> a
const a
newState, b
events)


{-|

This handler gives you access to whichever monad you're running Purview with.

__Example:__

If you wanted to print something on the server every time someone clicked
a button:

@
view _ = onClick "sayHello" $ button [ text "Say hello on the server" ]

handler = effectHandler [] () reduce
  where reduce "sayHello" state = do
          print "Someone on the browser says hello!"
          pure (const (), [])

component = handler view
@
-}
effectHandler
  :: ( Typeable event
     , Show state
     , Eq state
     , Typeable state
     )
  => [DirectedEvent parentEvent event]
  -- ^ Initial events to fire
  -> state
  -- ^ initial state
  -> (event -> state -> m (state -> state, [DirectedEvent parentEvent event]))
  -- ^ reducer (note the m!)
  -> (state -> Purview event m)
  -- ^ continuation
  -> Purview parentEvent m
effectHandler :: forall event state parentEvent (m :: * -> *).
(Typeable event, Show state, Eq state, Typeable state) =>
[DirectedEvent parentEvent event]
-> state
-> (event
    -> state -> m (state -> state, [DirectedEvent parentEvent event]))
-> (state -> Purview event m)
-> Purview parentEvent m
effectHandler [DirectedEvent parentEvent event]
initEvents state
state event
-> state -> m (state -> state, [DirectedEvent parentEvent event])
reducer state -> Purview event m
cont =
  forall state newEvent event (m :: * -> *).
(Show state, Eq state, Typeable state, Typeable newEvent) =>
ParentIdentifier
-> ParentIdentifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
    -> state -> m (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
EffectHandler forall a. Maybe a
Nothing forall a. Maybe a
Nothing [DirectedEvent parentEvent event]
initEvents state
state event
-> state -> m (state -> state, [DirectedEvent parentEvent event])
reducer state -> Purview event m
cont

{-|
To mirror handler', a shorthand for when you know you want to overwrite state.
-}
effectHandler'
  :: ( Typeable event
     , Show state
     , Eq state
     , Typeable state
     , Functor m
     )
  => [DirectedEvent parentEvent event]
  -- ^ Initial events to fire
  -> state
  -- ^ initial state
  -> (event -> state -> m (state, [DirectedEvent parentEvent event]))
  -- ^ reducer (note the m!)
  -> (state -> Purview event m)
  -- ^ continuation
  -> Purview parentEvent m
effectHandler' :: forall event state (m :: * -> *) parentEvent.
(Typeable event, Show state, Eq state, Typeable state,
 Functor m) =>
[DirectedEvent parentEvent event]
-> state
-> (event -> state -> m (state, [DirectedEvent parentEvent event]))
-> (state -> Purview event m)
-> Purview parentEvent m
effectHandler' [DirectedEvent parentEvent event]
initEvents state
state event -> state -> m (state, [DirectedEvent parentEvent event])
reducer state -> Purview event m
cont =
  forall state newEvent event (m :: * -> *).
(Show state, Eq state, Typeable state, Typeable newEvent) =>
ParentIdentifier
-> ParentIdentifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
    -> state -> m (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
EffectHandler forall a. Maybe a
Nothing forall a. Maybe a
Nothing [DirectedEvent parentEvent event]
initEvents state
state (forall {f :: * -> *} {p :: * -> * -> *} {t} {t} {a} {c} {b}.
(Functor f, Bifunctor p) =>
(t -> t -> f (p a c)) -> t -> t -> f (p (b -> a) c)
constReducer event -> state -> m (state, [DirectedEvent parentEvent event])
reducer) state -> Purview event m
cont
  where constReducer :: (t -> t -> f (p a c)) -> t -> t -> f (p (b -> a) c)
constReducer t -> t -> f (p a c)
reducer t
event t
state = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first forall a b. a -> b -> a
const) (t -> t -> f (p a c)
reducer t
event t
state)

{-|
For receiving events from Javascript.  In addition to the name and an event
producer, the receiver takes in a state and child and passes it through for
(hopefully) more natural composition with handlers.

__Example:__

This receives an event from javascript every 1 second and increments
the count.

@
component count = div [ text (show count) ]

countHandler = handler' [] (0 :: Int) reducer
  where
    reducer "increment" state = (state + 1, [])
    reducer "decrement" state = (state - 1, [])

countReceiver = receiver "incrementReceiver" (const "increment")

render = countHandler . countReceiver $ component

jsCounter = [r|
  const startCount = () => {
    window.setInterval(() => {
      -- sendEvent is added to the window by Purview and all that's
      -- needed.  Purview finds the receiver by name.
      sendEvent("incrementReceiver", "increment")
    }, 1000)
  }
  startCount()
|]

main = serve defaultConfiguration { javascript=jsCounter } render
@
-}
receiver
  :: ( Show event
     , Eq event
     , Typeable event
     )
  => String -> (Maybe String -> event) -> (state -> Purview event m) -> state -> Purview event m
receiver :: forall event state (m :: * -> *).
(Show event, Eq event, Typeable event) =>
String
-> (Maybe String -> event)
-> (state -> Purview event m)
-> state
-> Purview event m
receiver String
name Maybe String -> event
eventParser state -> Purview event m
child state
state = forall event state (m :: * -> *).
(Show event, Eq event, Typeable event) =>
ParentIdentifier
-> ParentIdentifier
-> String
-> (Maybe String -> event)
-> (state -> Purview event m)
-> state
-> Purview event m
Receiver forall a. Maybe a
Nothing forall a. Maybe a
Nothing String
name Maybe String -> event
eventParser state -> Purview event m
child state
state

{-

Helpers

-}

div :: [Purview event m] -> Purview event m
div :: forall event (m :: * -> *). [Purview event m] -> Purview event m
div = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"div"

span :: [Purview event m] -> Purview event m
span :: forall event (m :: * -> *). [Purview event m] -> Purview event m
span = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"span"

h1 :: [Purview event m] -> Purview event m
h1 :: forall event (m :: * -> *). [Purview event m] -> Purview event m
h1 = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"h1"

h2 :: [Purview event m] -> Purview event m
h2 :: forall event (m :: * -> *). [Purview event m] -> Purview event m
h2 = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"h2"

h3 :: [Purview event m] -> Purview event m
h3 :: forall event (m :: * -> *). [Purview event m] -> Purview event m
h3 = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"h3"

h4 :: [Purview event m] -> Purview event m
h4 :: forall event (m :: * -> *). [Purview event m] -> Purview event m
h4 = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"h4"

p :: [Purview event m] -> Purview event m
p :: forall event (m :: * -> *). [Purview event m] -> Purview event m
p = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"p"

a :: [Purview event m] -> Purview event m
a :: forall event (m :: * -> *). [Purview event m] -> Purview event m
a = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"a"

ul :: [Purview event m] -> Purview event m
ul :: forall event (m :: * -> *). [Purview event m] -> Purview event m
ul = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"ul"

li :: [Purview event m] -> Purview event m
li :: forall event (m :: * -> *). [Purview event m] -> Purview event m
li = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"li"

button :: [Purview event m] -> Purview event m
button :: forall event (m :: * -> *). [Purview event m] -> Purview event m
button = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"button"

form :: [Purview event m] -> Purview event m
form :: forall event (m :: * -> *). [Purview event m] -> Purview event m
form = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"form"

input :: [Purview event m] -> Purview event m
input :: forall event (m :: * -> *). [Purview event m] -> Purview event m
input = forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
"input"

text :: String -> Purview event m
text :: forall event (m :: * -> *). String -> Purview event m
text = forall event (m :: * -> *). String -> Purview event m
Text

{-|
For adding an "id" to HTML
-}
id' :: String -> Purview event m -> Purview event m
id' :: forall event (m :: * -> *).
String -> Purview event m -> Purview event m
id' = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event. String -> String -> Attributes event
Generic String
"id"

{-|
For adding a "class" to HTML
-}
class' :: String -> Purview event m -> Purview event m
class' :: forall event (m :: * -> *).
String -> Purview event m -> Purview event m
class' = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event. String -> String -> Attributes event
Generic String
"class"

classes :: [String] -> Purview event m -> Purview event m
classes :: forall event (m :: * -> *).
[String] -> Purview event m -> Purview event m
classes [String]
xs = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event. String -> String -> Attributes event
Generic String
"class" forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
xs

href :: String -> Purview event m -> Purview event m
href :: forall event (m :: * -> *).
String -> Purview event m -> Purview event m
href = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event. String -> String -> Attributes event
Generic String
"href"

{-|

For adding inline styles.  Good for dynamic parts of styling, as
the style QuasiQuoter does not support variables.

__Example:__

Varying a color based on input:

@
submitButton valid =
  let
    borderColor = if valid then "green" else "red"
    borderStyle = "border-color: " <> borderColor <> ";"
  in
    istyle borderStyle $ button [ text "Submit" ]
@
-}
istyle :: String -> Purview event m -> Purview event m
istyle :: forall event (m :: * -> *).
String -> Purview event m -> Purview event m
istyle String
str = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall a b. (a -> b) -> a -> b
$ forall event. (String, String) -> Attributes event
Style (String
"-1", String
str)

{-|

This will send the event to the handler above it whenever "click" is triggered
on the frontend.  It will be bound to whichever concrete HTML is beneath it.


__Example:__

To send a string based event:

@
toggleButton :: Purview String m
toggleButton = onClick "toggle" $ button []
@

To send a better typed event:

@
data Toggle = Toggle
  deriving (Show, Eq)

toggleButton :: Purview Toggle m
toggleButton = onClick Toggle $ button []
@

Note how the type changed to show which kind of event is produced.

-}
onClick :: (Typeable event, Eq event, Show event) => event -> Purview event m -> Purview event m
onClick :: forall event (m :: * -> *).
(Typeable event, Eq event, Show event) =>
event -> Purview event m -> Purview event m
onClick = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event.
(Show event, Eq event, Typeable event) =>
String
-> ParentIdentifier -> (Maybe String -> event) -> Attributes event
On String
"click" forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

{-|

This will send the event to the handler above it whenever "submit" is triggered
on the frontend.  It takes a function to transform the value received into
an event for handlers, this can be a good spot to debug trace and see what
is being received from the browser.

The form produces JSON so the handling function can also be used to parse
the form, or you can throw it up as a string for the handler to parse.

__Example:__

@
nameAttr = Attribute . Generic "name"

data FormEvent = Submitted String
  deriving (Show, Eq)

handleSubmit (Just val) = Submitted val
handleSubmit Nothing    = Submitted ""

component :: Purview FormEvent m
component = onSubmit handleSubmit $
  form
    [ nameAttr "text" $ input []
    ]
@
-}
onSubmit :: (Typeable event, Eq event, Show event) => (Maybe String -> event) -> Purview event m -> Purview event m
onSubmit :: forall event (m :: * -> *).
(Typeable event, Eq event, Show event) =>
(Maybe String -> event) -> Purview event m -> Purview event m
onSubmit = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event.
(Show event, Eq event, Typeable event) =>
String
-> ParentIdentifier -> (Maybe String -> event) -> Attributes event
On String
"submit" forall a. Maybe a
Nothing

{-|
This is triggered on focusout instead of blur to work with mobile
sites as well.  Like onSubmit it takes a value.

__Example:__

@
data AddressEvent = LineOneUpdated String
  deriving (Show, Eq)

handleBlur (Just val) = LineOneUpdated val
handleBlur Nothing    = LineOneUpdated ""

addressLineOne = onBlur handleBlur $ input []
@
-}
onBlur :: (Typeable event, Eq event, Show event) => (Maybe String -> event) -> Purview event m -> Purview event m
onBlur :: forall event (m :: * -> *).
(Typeable event, Eq event, Show event) =>
(Maybe String -> event) -> Purview event m -> Purview event m
onBlur = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event.
(Show event, Eq event, Typeable event) =>
String
-> ParentIdentifier -> (Maybe String -> event) -> Attributes event
On String
"focusout" forall a. Maybe a
Nothing

{-|
Triggered on change

__Example:__

@
data AddressEvent = LineOneUpdated String
  deriving (Show, Eq)

handleChange (Just val) = LineOneUpdated val
handleChange Nothing    = LineOneUpdated ""

addressLineOne = onChange handleChange $ input []
@
-}
onChange :: (Typeable event, Eq event, Show event) => (Maybe String -> event) -> Purview event m -> Purview event m
onChange :: forall event (m :: * -> *).
(Typeable event, Eq event, Show event) =>
(Maybe String -> event) -> Purview event m -> Purview event m
onChange = forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event.
(Show event, Eq event, Typeable event) =>
String
-> ParentIdentifier -> (Maybe String -> event) -> Attributes event
On String
"change" forall a. Maybe a
Nothing