{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}

module Nucleic.Element (
  Window, Element, ContainerElement,
  Style, style,
  DocumentM,
  asHTMLElement, 
  runDocument, withDocument,
  attachChild,
  body, div, helem, para, text,
  textInput, inputButton, button, anchor,
  spacer,
  flow, row, rowrev, column
) where

import           Control.Monad.Reader (ReaderT , MonadIO, runReaderT, liftIO, ask)
import           Data.Monoid ((<>))
import           Data.Text (Text)
import qualified GHCJS.DOM as DOM
import qualified GHCJS.DOM.Document as DOC
import           GHCJS.DOM.Element (elementGetAttribute, elementSetAttribute,
                                    elementOnkeyup, elementOnclick)
import qualified GHCJS.DOM.EventM as EVT
import qualified GHCJS.DOM.HTMLAnchorElement as ANCHOR
import qualified GHCJS.DOM.HTMLButtonElement as BUTTON
import qualified GHCJS.DOM.HTMLDivElement as DIV
import           GHCJS.DOM.HTMLElement (HTMLElement, castToHTMLElement)
import qualified GHCJS.DOM.HTMLInputElement as INPUT
import qualified GHCJS.DOM.HTMLParagraphElement as PARA
import qualified GHCJS.DOM.Node as NODE
import qualified GHCJS.DOM.Types as DTYPE
import           Prelude hiding (div)
import           Nucleic.IO (Signal, Edge, pushS, pushE)
import           Nucleic.Style (Style (..))

type Window           = DOM.WebView
type Element          = HTMLElement
type ContainerElement = DIV.HTMLDivElement

type DocumentM e = (DTYPE.IsHTMLElement e, MonadIO m) => ReaderT DOC.Document m e
type FlowLayout  = (DTYPE.IsHTMLElement e) => ContainerElement -> [e] -> IO ContainerElement

styleAttr :: Text
styleAttr = "style"

styleSep :: Text
styleSep = ";"

runDocument :: (DTYPE.IsHTMLElement e) => DocumentM e -> DOC.Document -> IO e
runDocument docM doc = runReaderT docM doc

withDocument :: (DTYPE.IsHTMLElement e) => DOC.Document -> DocumentM e -> IO e
withDocument doc docM = runDocument docM doc
-- Low Level Helpers

style :: (DTYPE.IsHTMLElement e) => Style -> e -> DocumentM e
style (Style s') e =
  appendStyle e s'

appendStyle :: (DTYPE.IsHTMLElement e) => e -> Text -> DocumentM e
appendStyle e style' = do
 _ <- liftIO $ do
       s <- (elementGetAttribute e styleAttr) :: IO Text
       elementSetAttribute e styleAttr (style' <> styleSep <> s)
 return e

-- Flow Item

-- Flow Container

flowLayout :: Text -> FlowLayout
flowLayout dir container elems = do
  elementSetAttribute container styleAttr (layout)
  mapM_ append elems
  return container
  where
    append e = NODE.nodeAppendChild container (Just e)
    layout = ("display:-webkit-flex;display:flex;-webkit-flex-direction:" ::Text) <> dir <>
             (";flex-direction:" :: Text) <> dir

row :: FlowLayout
row = flowLayout "row"

rowrev :: FlowLayout
rowrev = flowLayout "row-reverse"

column :: FlowLayout
column = flowLayout "column"

spacer :: DocumentM ContainerElement
spacer = div

flow :: (DTYPE.IsHTMLElement e) => FlowLayout -> [e] -> DocumentM ContainerElement
flow layout kids =
 do root <- div
    liftIO $ layout root kids
    --liftIO $ layout root kids
    --return root

helem :: (DTYPE.IsHTMLElement e) => e -> Element
helem e = castToHTMLElement e

-- Elements

div :: DocumentM ContainerElement
div = do
  e <- createElement "div" []
  return $ DIV.castToHTMLDivElement e

-- Input Elements

createElement :: Text -> [(Text,Text)] -> DocumentM Element
createElement etype attrs = do
  doc <- ask
  liftIO $ do
    Just e <- DOC.documentCreateElement doc etype
    elementSetAttribute e styleAttr ("" :: Text)
    mapM_ (\(akey, aval) -> elementSetAttribute e akey aval) attrs
    let e' = castToHTMLElement e
    return e'

anchor :: Text -> Text -> DocumentM ANCHOR.HTMLAnchorElement
anchor txt href = do
  e <- createElement "a" []
  _ <- liftIO $ do
    NODE.nodeSetTextContent e txt
    elementSetAttribute e ("href" :: Text) href
  return $ ANCHOR.castToHTMLAnchorElement e

inputElement :: Text -> [(Text, Text)] -> DocumentM INPUT.HTMLInputElement
inputElement itype attrs = do
  e <-  createElement inputTag ((attrType, itype) : attrs)
  liftIO $ return (INPUT.castToHTMLInputElement e)
  where
    attrType  = "type"  :: Text
    inputTag  = "input" :: Text

inputButton :: Text -> DocumentM INPUT.HTMLInputElement
inputButton label =
  inputElement inputType [("value" :: Text, label)]
  where
    inputType = "button" :: Text

button :: Text -> Edge () -> DocumentM BUTTON.HTMLButtonElement
button label evt = do
  e <- createElement "button" []
  _ <- liftIO $ NODE.nodeSetTextContent e label
  let handler = liftIO $ pushE evt ()
  liftIO $ elementOnclick e handler
  return $ BUTTON.castToHTMLButtonElement e

textInput :: Signal Text -> Text -> DocumentM INPUT.HTMLInputElement
textInput s val = do
     input <- inputElement inputTag [(attrType, textAttrInput),
                                    (attrDefault, val),
                                    (attrPlaceholder, val),
                                    (attrAuto, "true" :: Text)]
     let handler = do tgt <- EVT.target
                      liftIO $ INPUT.htmlInputElementGetValue tgt >>= pushS s
     _ <- liftIO $ elementOnkeyup input handler
     return input
    where
      attrAuto        = "autocomplete" :: Text
      attrDefault     = "defaultValue" :: Text
      attrPlaceholder = "placeholder"  :: Text
      attrType        = "type"  :: Text
      textAttrInput   = "text"  :: Text
      inputTag        = "input" :: Text

para :: Text -> DocumentM PARA.HTMLParagraphElement
para txt = do
  e <- createElement "p" []
  e' <- liftIO $ do
        let e'' = PARA.castToHTMLParagraphElement e
        NODE.nodeSetTextContent e'' txt
        return e''
  return e'

text :: Text -> DocumentM Element
text txt = do
  e <- createElement "span" []
  liftIO $ NODE.nodeSetTextContent e txt
  return e
  
-- DOM

body :: DocumentM Element
body = do
  doc <- ask
  Just b <- liftIO $ DOC.documentGetBody doc
  return b

attachChild :: (DTYPE.IsHTMLElement p, DTYPE.IsHTMLElement c) =>
               c -> p -> DocumentM p
attachChild c p = do
  _ <- liftIO $ NODE.nodeAppendChild (helem p) (Just (helem c))
  return p
  
asHTMLElement :: DTYPE.IsHTMLElement e => e -> DocumentM Element
asHTMLElement = return . helem 
