{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo       #-}
{-# LANGUAGE TypeFamilies      #-}


-- | This is just a copy of the upstream code except polymorphic:
--   Get rid of m ~ Ghcjsdomspace to allow these widgets to be prerendered
module Reflex.Bulmex.Input.Polymorphic
  (textInput, TextInput(..), textArea, TextArea(..), textArea_value, textArea_keypress
  , textInput_value
  , textInput_keyup
  , textInput_keypress
  , textInput_keydown
  , textInput_input
  , textInput_hasFocus
  ) where

import           Control.Lens
import qualified Data.Map.Strict          as Map
import qualified Data.Text                as Text
import           Reflex
import           Reflex.Dom.Builder.Class
import           Reflex.Dom.Widget.Basic
import qualified Reflex.Dom.Widget.Input  as Inp

textInput :: (DomBuilder t m, PostBuild t m) => Inp.TextInputConfig t -> m (TextInput t)
textInput (Inp.TextInputConfig inputType initial eSetValue dAttrs) = do
  modifyAttrs <- dynamicAttributesToModifyAttributes $ fmap (Map.insert "type" inputType) dAttrs
  i <- inputElement $ Inp.def
    &  inputElementConfig_initialValue .~ initial
    &  inputElementConfig_setValue .~ eSetValue
    &  inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs
  return $ TextInput
    { _textInput_value = _inputElement_value i
    , _textInput_input = _inputElement_input i
    , _textInput_keypress = domEvent Keypress i
    , _textInput_keydown = domEvent Keydown i
    , _textInput_keyup = domEvent Keyup i
    , _textInput_hasFocus = _inputElement_hasFocus i
    }

data TextInput t
   = TextInput { _textInput_value    :: Dynamic t Text.Text
               , _textInput_input    :: Event t Text.Text
               , _textInput_keypress :: Event t Word
               , _textInput_keydown  :: Event t Word
               , _textInput_keyup    :: Event t Word
               , _textInput_hasFocus :: Dynamic t Bool
               }

instance Inp.HasValue (TextInput t) where
    type Value (TextInput t) = Dynamic t Text.Text
    value = _textInput_value

textArea :: (DomBuilder t m, PostBuild t m) => Inp.TextAreaConfig t -> m (TextArea t)
textArea (Inp.TextAreaConfig initial eSet attrs) = do
  modifyAttrs <- dynamicAttributesToModifyAttributes attrs
  i <- textAreaElement $ Inp.def
    & textAreaElementConfig_initialValue .~ initial
    & textAreaElementConfig_setValue .~ eSet
    & textAreaElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs
  return $ TextArea
    { _textArea_value = _textAreaElement_value i
    , _textArea_input = _textAreaElement_input i
    , _textArea_keypress = domEvent Keypress i
    , _textArea_hasFocus = _textAreaElement_hasFocus i
    }

data TextArea t = TextArea { _textArea_value :: Dynamic t Text.Text
              , _textArea_input              :: Event t Text.Text
              , _textArea_hasFocus           :: Dynamic t Bool
              , _textArea_keypress           :: Event t Word
              }

instance Inp.HasValue (TextArea t) where
    type Value (TextArea t) = Dynamic t Text.Text
    value = _textArea_value

textArea_keypress :: Lens' (TextArea t) (Event t Word)
textArea_keypress f (TextArea x1 x2 x3 x4) = (\y -> TextArea x1 x2 x3 y) <$> f x4

textArea_value :: Lens' (TextArea t) (Dynamic t Text.Text)
textArea_value f (TextArea x1 x2 x3 x4) = (\y -> TextArea y x2 x3 x4) <$> f x1

textInput_hasFocus :: Lens' (TextInput t) (Dynamic t Bool)
textInput_hasFocus f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 x2 x3 x4 x5 y ) <$> f x6

textInput_input :: Lens' (TextInput t) (Event t Text.Text)
textInput_input f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 y x3 x4 x5 x6 ) <$> f x2

textInput_keydown :: Lens' (TextInput t) (Event t Word)
textInput_keydown f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 x2 x3 y x5 x6 ) <$> f x4

textInput_keypress :: Lens' (TextInput t) (Event t Word)
textInput_keypress f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 x2 y x4 x5 x6 ) <$> f x3

textInput_keyup :: Lens' (TextInput t) (Event t Word)
textInput_keyup f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 x2 x3 x4 y x6 ) <$> f x5

textInput_value :: Lens' (TextInput t) (Dynamic t Text.Text)
textInput_value f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput y x2 x3 x4 x5 x6) <$> f x1