module Rendering where

import           Data.Aeson
import           Data.ByteString.Lazy.Char8 (unpack)
import           Unsafe.Coerce

import           Component

isOn :: Attributes a -> Bool
isOn :: forall a. Attributes a -> Bool
isOn (On String
_ a
_) = Bool
True
isOn Attributes a
_        = Bool
False

isGeneric :: Attributes a -> Bool
isGeneric :: forall a. Attributes a -> Bool
isGeneric (Generic String
_ String
_) = Bool
True
isGeneric Attributes a
_ = Bool
False

getStyle :: Attributes a -> String
getStyle :: forall a. Attributes a -> String
getStyle (Style String
style') = String
style'
getStyle Attributes a
_              = String
""

renderGeneric :: Attributes a -> String
renderGeneric :: forall a. Attributes a -> String
renderGeneric Attributes a
attr = case Attributes a
attr of
  (Generic String
name String
value) -> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
unpack (String -> ByteString
forall a. ToJSON a => a -> ByteString
encode String
value)
  Attributes a
_ -> String
""

renderAttributes :: [Attributes a] -> String
renderAttributes :: forall a. [Attributes a] -> String
renderAttributes [Attributes a]
attrs =
  let
    styles :: String
styles = (Attributes a -> String) -> [Attributes a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Attributes a -> String
forall a. Attributes a -> String
getStyle [Attributes a]
attrs
    renderedStyle :: String
renderedStyle = if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
styles) then String
" style=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
styles else String
""

    listeners :: [Attributes a]
listeners = (Attributes a -> Bool) -> [Attributes a] -> [Attributes a]
forall a. (a -> Bool) -> [a] -> [a]
filter Attributes a -> Bool
forall a. Attributes a -> Bool
isOn [Attributes a]
attrs
    renderedListeners :: String
renderedListeners = (Attributes a -> String) -> [Attributes a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      (\(On String
name a
action) -> String
" action=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (ByteString -> String
unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
action))
      [Attributes a]
listeners

    generics :: [Attributes a]
generics = (Attributes a -> Bool) -> [Attributes a] -> [Attributes a]
forall a. (a -> Bool) -> [a] -> [a]
filter Attributes a -> Bool
forall a. Attributes a -> Bool
isGeneric [Attributes a]
attrs
    renderedGenerics :: String
renderedGenerics = (Attributes a -> String) -> [Attributes a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Attributes a -> String
forall a. Attributes a -> String
renderGeneric [Attributes a]
generics
  in
    String
renderedStyle String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
renderedListeners String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
renderedGenerics

{-|

Takes the tree and turns it into HTML.  Attributes are passed down to children until
they reach a real HTML tag.

-}

render :: Purview parentAction action m -> String
render :: forall parentAction action (m :: * -> *).
Purview parentAction action m -> String
render = [Attributes action] -> Purview parentAction action m -> String
forall action parentAction (m :: * -> *).
[Attributes action] -> Purview parentAction action m -> String
render' []

render' :: [Attributes action] -> Purview parentAction action m -> String
render' :: forall action parentAction (m :: * -> *).
[Attributes action] -> Purview parentAction action m -> String
render' [Attributes action]
attrs Purview parentAction action m
tree = case Purview parentAction action m
tree of
  Html String
kind [Purview parentAction action m]
rest ->
    String
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
kind String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Attributes action] -> String
forall a. [Attributes a] -> String
renderAttributes [Attributes action]
attrs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
    String -> String -> String
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 ([Attributes action] -> Purview parentAction action m -> String
forall action parentAction (m :: * -> *).
[Attributes action] -> Purview parentAction action m -> String
render' []) [Purview parentAction action m]
rest String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
    String
"</" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
kind String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"

  Text String
val -> String
val

  Attribute Attributes action
attr Purview parentAction action m
rest ->
    [Attributes action] -> Purview parentAction action m -> String
forall action parentAction (m :: * -> *).
[Attributes action] -> Purview parentAction action m -> String
render' (Attributes action
attrAttributes action -> [Attributes action] -> [Attributes action]
forall a. a -> [a] -> [a]
:[Attributes action]
attrs) Purview parentAction action m
rest

  EffectHandler Identifier
parentLocation Identifier
location state
state action
-> state -> m (state -> state, [DirectedEvent parentAction action])
_ state -> Purview action any m
cont ->
    String
"<div handler=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (Identifier -> ByteString) -> Identifier -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> ByteString
forall a. ToJSON a => a -> ByteString
encode) Identifier
location String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
      [Attributes action] -> Purview Any action Any -> String
forall action parentAction (m :: * -> *).
[Attributes action] -> Purview parentAction action m -> String
render' [Attributes action]
attrs ((state -> Purview action any m) -> state -> Purview Any action Any
forall a b. a -> b
unsafeCoerce state -> Purview action any m
cont state
state) String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
    String
"</div>"

  Once (action -> Event) -> Event
_ Bool
_hasRun Purview parentAction action m
cont ->
    [Attributes action] -> Purview parentAction action m -> String
forall action parentAction (m :: * -> *).
[Attributes action] -> Purview parentAction action m -> String
render' [Attributes action]
attrs Purview parentAction action m
cont

  Value a
a -> a -> String
forall a. Show a => a -> String
show a
a

  Hide Purview parentAction newAction m
a -> [Attributes action] -> Purview Any action Any -> String
forall action parentAction (m :: * -> *).
[Attributes action] -> Purview parentAction action m -> String
render' [Attributes action]
attrs (Purview parentAction newAction m -> Purview Any action Any
forall a b. a -> b
unsafeCoerce Purview parentAction newAction m
a)