{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
module Component where

import           Data.Aeson
import           Data.Typeable

import           Events

{-|

Attributes are collected until an 'HTML' constructor is hit, where they
are applied during rendering.

-}
data Attributes action where
  On :: ToJSON action => String -> action -> Attributes action
  -- ^ part of creating handlers for different events, e.g. On "click"
  Style :: String -> Attributes action
  -- ^ inline css
  Generic :: String -> String -> Attributes action
  -- ^ for creating new Attributes to put on HTML, e.g. Generic "type" "radio" for type="radio".

instance Eq (Attributes action) where
  (Style String
a) == :: Attributes action -> Attributes action -> Bool
== (Style String
b) = String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b
  (Style String
_) == Attributes action
_ = Bool
False

  (On String
kind action
action) == (On String
kind' action
action') = String
kind String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
kind' Bool -> Bool -> Bool
&& action -> ByteString
forall a. ToJSON a => a -> ByteString
encode action
action ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== action -> ByteString
forall a. ToJSON a => a -> ByteString
encode action
action'
  (On String
_ action
_) == Attributes action
_ = Bool
False

  (Generic String
name String
value) == (Generic String
name' String
value') = String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' Bool -> Bool -> Bool
&& String
value String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
value'
  (Generic String
_ String
_) == Attributes action
_ = Bool
False

type Identifier = Maybe [Int]
type ParentIdentifier = Identifier

{-|

This is what you end up building using the various helpers.  It's hopefully rare
that you have to use these directly, but it may be useful to better understand
what's happening behind the scenes.

-}
data Purview parentAction action m where
  Attribute :: Attributes action -> Purview parentAction action m -> Purview parentAction action m
  Text :: String -> Purview parentAction action m
  Html :: String -> [Purview parentAction action m] -> Purview parentAction action m
  Value :: Show a => a -> Purview parentAction action m

  -- | All the handlers boil down to this one.
  EffectHandler
    :: ( FromJSON newAction
       , ToJSON newAction
       , ToJSON parentAction
       , FromJSON state
       , ToJSON state
       , Typeable state
       , Eq state
       )
    => ParentIdentifier
    -- ^ The location of the parent effect handler (provided by prepareTree)
    -> Identifier
    -- ^ The location of this effect handler (provided by prepareTree)
    -> state
    -- ^ The initial state
    -> (newAction-> state -> m (state -> state, [DirectedEvent parentAction newAction]))
    -- ^ Receive an action, change the state, and send messages
    -> (state -> Purview newAction any m)
    -- ^ Continuation
    -> Purview parentAction newAction m

  Once
    :: (ToJSON action)
    => ((action -> Event) -> Event)
    -> Bool  -- has run
    -> Purview parentAction action m
    -> Purview parentAction action m

  Hide :: Purview parentAction newAction m -> Purview parentAction any m

instance Show (Purview parentAction action m) where
  show :: Purview parentAction action m -> String
show (EffectHandler ParentIdentifier
parentLocation ParentIdentifier
location state
state action
-> state -> m (state -> state, [DirectedEvent parentAction action])
_action state -> Purview action any m
cont) =
    String
"EffectHandler "
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParentIdentifier -> String
forall a. Show a => a -> String
show ParentIdentifier
parentLocation String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" "
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParentIdentifier -> String
forall a. Show a => a -> String
show ParentIdentifier
location String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" "
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show (state -> ByteString
forall a. ToJSON a => a -> ByteString
encode state
state) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" "
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview action any m -> String
forall a. Show a => a -> String
show (state -> Purview action any m
cont state
state)
  show (Once (action -> Event) -> Event
_ Bool
hasRun Purview parentAction action m
cont) = String
"Once " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall a. Show a => a -> String
show Bool
hasRun String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview parentAction action m -> String
forall a. Show a => a -> String
show Purview parentAction action m
cont
  show (Attribute Attributes action
_attrs Purview parentAction action m
cont) = String
"Attr " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview parentAction action m -> String
forall a. Show a => a -> String
show Purview parentAction action m
cont
  show (Text String
str) = ShowS
forall a. Show a => a -> String
show String
str
  show (Html String
kind [Purview parentAction action m]
children) =
    String
kind String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" [ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Purview parentAction action m -> String)
-> [Purview parentAction action m] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) String
" " ShowS
-> (Purview parentAction action m -> String)
-> Purview parentAction action m
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Purview parentAction action m -> String
forall a. Show a => a -> String
show) [Purview parentAction action m]
children String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ] "
  show (Value a
value) = a -> String
forall a. Show a => a -> String
show a
value
  show (Hide Purview parentAction newAction m
a) = String
"Hide " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview parentAction newAction m -> String
forall a. Show a => a -> String
show Purview parentAction newAction m
a

instance Eq (Purview parentAction action m) where
  Purview parentAction action m
a == :: Purview parentAction action m
-> Purview parentAction action m -> Bool
== Purview parentAction action m
b = Purview parentAction action m -> String
forall a. Show a => a -> String
show Purview parentAction action m
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Purview parentAction action m -> String
forall a. Show a => a -> String
show Purview parentAction action m
b

{-|

This is most straightforward effect handler.  It can't send messages to itself
or to its parent.

For example, let's say you want to make a button that switches between saying
"up" or "down":

> view direction = onClick "toggle" $ button [ text direction ]
>
> handler = simpleHandler "up" reduce
>   where reduce "toggle" state = if state == "up" then "down" else "up"
>
> component = handler view

-}
simpleHandler
  :: ( FromJSON action
     , FromJSON state
     , ToJSON action
     , ToJSON parentAction
     , ToJSON state
     , Typeable state
     , Eq state
     , Applicative m
     )
  => state
  -- ^ The initial state
  -> (action -> state -> state)
  -- ^ The reducer, or how the state should change for an action
  -> (state -> Purview action any1 m)
  -- ^ The continuation / component to connect to
  -> Purview parentAction any2 m
simpleHandler :: forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
 ToJSON parentAction, ToJSON state, Typeable state, Eq state,
 Applicative m) =>
state
-> (action -> state -> state)
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
simpleHandler state
state action -> state -> state
handler =
  state
-> (action
    -> state
    -> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
 ToJSON parentAction, ToJSON state, Typeable state, Eq state) =>
state
-> (action
    -> state
    -> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
effectHandler state
state (\action
action state
state -> (state -> state, [DirectedEvent parentAction action])
-> m (state -> state, [DirectedEvent parentAction action])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (state -> state -> state
forall a b. a -> b -> a
const (state -> state -> state) -> state -> state -> state
forall a b. (a -> b) -> a -> b
$ action -> state -> state
handler action
action state
state, []))

{-|

More powerful than the 'simpleHandler', it can send messages to itself or its
parent.  You will also note that instead of just returning the new state, it
returns a function to transform the state.  This is because handlers run in
their own threads.

-}
messageHandler
  :: ( FromJSON action
     , FromJSON state
     , ToJSON action
     , ToJSON parentAction
     , ToJSON state
     , Typeable state
     , Eq state
     , Applicative m
     )
  => state
  -- ^ initial state
  -> (action -> state -> (state -> state, [DirectedEvent parentAction action]))
  -- ^ reducer
  -> (state -> Purview action any1 m)
  -- ^ continuation
  -> Purview parentAction any2 m
messageHandler :: forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
 ToJSON parentAction, ToJSON state, Typeable state, Eq state,
 Applicative m) =>
state
-> (action
    -> state -> (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
messageHandler state
state action
-> state -> (state -> state, [DirectedEvent parentAction action])
handler =
  state
-> (action
    -> state
    -> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
 ToJSON parentAction, ToJSON state, Typeable state, Eq state) =>
state
-> (action
    -> state
    -> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
effectHandler state
state (\action
action state
state -> (state -> state, [DirectedEvent parentAction action])
-> m (state -> state, [DirectedEvent parentAction action])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (action
-> state -> (state -> state, [DirectedEvent parentAction action])
handler action
action state
state))

{-|

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

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

> view direction = onClick "sayHello" $ button [ text "Say hello on the server" ]
>
> handler = effectHandler Nothing reduce
>   where reduce "sayHello" state = do
>           print "someone on the browser says hello!"
>           pure (const Nothing, [])
>
> component = handler view

-}
effectHandler
  :: ( FromJSON action
     , FromJSON state
     , ToJSON action
     , ToJSON parentAction
     , ToJSON state
     , Typeable state
     , Eq state
     )
  => state
  -- ^ initial state
  -> (action -> state -> m (state -> state, [DirectedEvent parentAction action]))
  -- ^ reducer (note the m!)
  -> (state -> Purview action any1 m)
  -- ^ continuation
  -> Purview parentAction any2 m
effectHandler :: forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
 ToJSON parentAction, ToJSON state, Typeable state, Eq state) =>
state
-> (action
    -> state
    -> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
effectHandler state
state action
-> state -> m (state -> state, [DirectedEvent parentAction action])
handler =
  Purview parentAction action m -> Purview parentAction any2 m
forall parentAction state (m :: * -> *) any.
Purview parentAction state m -> Purview parentAction any m
Hide (Purview parentAction action m -> Purview parentAction any2 m)
-> ((state -> Purview action any1 m)
    -> Purview parentAction action m)
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParentIdentifier
-> ParentIdentifier
-> state
-> (action
    -> state
    -> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction action m
forall newAction parentAction state (m :: * -> *) any.
(FromJSON newAction, ToJSON newAction, ToJSON parentAction,
 FromJSON state, ToJSON state, Typeable state, Eq state) =>
ParentIdentifier
-> ParentIdentifier
-> state
-> (newAction
    -> state
    -> m (state -> state, [DirectedEvent parentAction newAction]))
-> (state -> Purview newAction any m)
-> Purview parentAction newAction m
EffectHandler ParentIdentifier
forall a. Maybe a
Nothing ParentIdentifier
forall a. Maybe a
Nothing state
state action
-> state -> m (state -> state, [DirectedEvent parentAction action])
handler

{-|

This is for kicking off loading events.  Put it beneath one of your handlers
to send an event up to it, and it will only be sent once.

-}
once
  :: ToJSON action
  => ((action -> Event) -> Event)
  -> Purview parentAction action m
  -> Purview parentAction action m
once :: forall action parentAction (m :: * -> *).
ToJSON action =>
((action -> Event) -> Event)
-> Purview parentAction action m -> Purview parentAction action m
once (action -> Event) -> Event
sendAction = ((action -> Event) -> Event)
-> Bool
-> Purview parentAction action m
-> Purview parentAction action m
forall action parentAction (m :: * -> *).
ToJSON action =>
((action -> Event) -> Event)
-> Bool
-> Purview parentAction action m
-> Purview parentAction action m
Once (action -> Event) -> Event
sendAction Bool
False

{-

Helpers

-}

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

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

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

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

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

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

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

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

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

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

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

{-|

For adding styles

> blue = style "color: \"blue\";"
> blueButton = blue $ button [ text "I'm blue" ]

-}
style :: String -> Purview parentAction action m -> Purview parentAction action m
style :: forall parentAction action (m :: * -> *).
String
-> Purview parentAction action m -> Purview parentAction action m
style = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
 -> Purview parentAction action m -> Purview parentAction action m)
-> (String -> Attributes action)
-> String
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes action
forall action. String -> Attributes action
Style

{-|

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

-}
onClick :: ToJSON action => action -> Purview parentAction action m -> Purview parentAction action m
onClick :: forall action parentAction (m :: * -> *).
ToJSON action =>
action
-> Purview parentAction action m -> Purview parentAction action m
onClick = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
 -> Purview parentAction action m -> Purview parentAction action m)
-> (action -> Attributes action)
-> action
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> action -> Attributes action
forall action.
ToJSON action =>
String -> action -> Attributes action
On String
"click"

{-|

This will send the action to the handler above it whenever "submit" is triggered
on the frontend.

-}
onSubmit :: ToJSON action => action -> Purview parentAction action m -> Purview parentAction action m
onSubmit :: forall action parentAction (m :: * -> *).
ToJSON action =>
action
-> Purview parentAction action m -> Purview parentAction action m
onSubmit = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
 -> Purview parentAction action m -> Purview parentAction action m)
-> (action -> Attributes action)
-> action
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> action -> Attributes action
forall action.
ToJSON action =>
String -> action -> Attributes action
On String
"submit"

identifier :: String -> Purview parentAction action m -> Purview parentAction action m
identifier :: forall parentAction action (m :: * -> *).
String
-> Purview parentAction action m -> Purview parentAction action m
identifier = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
 -> Purview parentAction action m -> Purview parentAction action m)
-> (String -> Attributes action)
-> String
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Attributes action
forall action. String -> String -> Attributes action
Generic String
"id"

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