{-# LANGUAGE RecursiveDo, OverloadedStrings #-}

module Estuary.Widgets.Reflex where

-- This module is for definitions that extend the affordances of reflex and reflex-dom in
-- ways that are specific to the Estuary client but generically useful across multiple
-- widgets/settings/modules within the client.

import Reflex
import Reflex.Dom hiding (Delete,Insert)
import Data.Map
import Data.Text (Text)
import qualified Data.Text as T
import GHCJS.DOM.EventM
import qualified GHCJS.DOM.Types as G
import qualified GHCJS.DOM.GlobalEventHandlers as G
import qualified GHCJS.DOM.DocumentAndElementEventHandlers as G
import Data.Map
import Data.Maybe
import Data.List
import Data.Bool (bool)
import Data.Maybe
import Data.Monoid
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Fix
import GHCJS.DOM.HTMLSelectElement as Select
import Safe -- for readMay
import GHCJS.DOM.GlobalEventHandlers (change)
import Data.List (nub, elemIndex)
import Text.Read (readMaybe)
import qualified GHCJS.Types as T
import qualified GHCJS.Marshal.Pure as P
import Data.Functor.Misc -- For Const2

import Estuary.Types.Term
import Estuary.Types.Context
import Estuary.Types.Language
import Estuary.Types.TranslatableText
import Estuary.Tidal.Types
import Estuary.Types.Live
import Estuary.Types.Hint


-- the former 'dynEditor'...
dyn' :: MonadWidget t m => Dynamic t (m a) -> m (Dynamic t a)
dyn' x = do
  initialWidget <- sample $ current x
  widgetHold initialWidget $ updated x -- m (Dynamic t a)

-- for dynamic attributes
dynAttr :: Reflex t => Text -> Dynamic t Text -> Dynamic t (Map Text Text)
dynAttr k = fmap (Data.Map.singleton k)

-- a temporary button with class for the reference files
buttonWithClass' :: MonadWidget t m => Text -> m (Event t ())
buttonWithClass' s = do
  (e, _) <- elAttr' "button" (fromList [("type", "button"), ("class", "ui-buttons code-font primary-color"), ("style", "background-color:transparent; border:none; cursor:help")]) $ text s
  return $ domEvent Click e

-- a button with class
buttonWithClass :: MonadWidget t m => Text -> m (Event t ())
buttonWithClass s = do
  (e, _) <- elAttr' "button" (fromList [("type", "button"), ("class", "ui-buttons other-borders code-font")]) $ text s
  return $ domEvent Click e

buttonWithSettableClass :: MonadWidget t m => Text -> Text -> m (Event t ())
buttonWithSettableClass c s = do
  (e, _) <- elAttr' "button" (fromList [("type", "button"), ("class", c)]) $ text s
  return $ domEvent Click e

-- used in the footer
invisibleButton :: MonadWidget t m => m (Event t ())
invisibleButton = do
  (e, _) <- elAttr' "button" (fromList [("type", "button"), ("class", "invisible-button")]) $ text "none"
  return $ domEvent Click e

--button with dynamic label and settable class
dynButtonWSettableClass :: MonadWidget t m => Dynamic t Text -> Dynamic t Text -> m (Event t ())
dynButtonWSettableClass c s = dynE (buttonWithSettableClass <$> c <*> s)


-- dynButtonWSettableClass' :: MonadWidget t m => Dynamic t Text -> Dynamic t Text -> Dynamic t (m (Event t a))
-- dynButtonWSettableClass' c s = buttonWithSettableClass <$> c <*> s
--

--Button with dynamic label.
dynButton :: MonadWidget t m => Dynamic t Text -> m (Event t ())
dynButton = dynE . fmap buttonWithClass

dynButtonWithChild :: MonadWidget t m => String -> m () -> m (Event t ())
dynButtonWithChild cls child = do
  (e, _) <- elAttr' "div" (fromList [("type", "button"), ("class", T.pack $ cls ++ " btn")]) child
  return $ domEvent Click e

-- | dynE is like dyn from Reflex, specialized for widgets that return
-- events. A dynamic argument updates the widget, and the return value is
-- already flattened to just being the events returned by the child widget.
dynE :: MonadWidget t m => Dynamic t (m (Event t a)) -> m (Event t a)
dynE x = dyn x >>= switchPromptly never

-- a button that, instead of producing Event t (), produces an event of
-- some constant value
button' :: (MonadWidget t m) => Text -> a -> m (Event t a)
button' t r = do
  x <- button t
  return (r <$ x)

-- Button With Dynamic attributes
buttonDynAttrs :: MonadWidget t m => Text -> a -> Dynamic t (Map Text Text)-> m (Event t a)
buttonDynAttrs s val attrs = do
  (e, _) <- elDynAttr' "button" attrs $ text s
  let event = domEvent Click e
  return (val <$ event)

-- Creates dropdown Menu with Subheaders
-- takes a Map of integers (the order everything should be displayed in)
-- to String tuples. The first String of the tuple indicates a subheader,
-- and the second indicates the selectable item under it. DropdownConfig options
-- expect the same as with a regular dropdown
dropdownOpts :: (MonadWidget t m) => Int -> Map Int (Text,Text) ->  DropdownConfig t Int -> m (Dropdown t Int)
dropdownOpts k0 setUpMap (DropdownConfig setK attrs) = do
  let options = fromList $ Prelude.zip (keys setUpMap) $ fmap snd $ elems setUpMap
  let optGroups = fromList $ Prelude.zip (keys setUpMap) $ fmap fst $ elems setUpMap
  let optGroupPositions = fmap (\x-> maybe (0) id $ Data.List.elemIndex x (elems optGroups)) $ nub $ elems optGroups -- [Int]
  (eRaw, _) <- elDynAttr' "select" attrs $ do
    let optionsWithDefault = constDyn $ if Data.Map.lookup k0 options == Nothing then Data.Map.union (k0 =: "") options else options
    listWithKey optionsWithDefault $ \k v -> do
      if not (elem k optGroupPositions) then blank else do
        elAttr "optgroup" ("label"=:(maybe "" id $ Data.Map.lookup k optGroups)) $ blank
      elAttr "option" ("value" =: (T.pack . show) k <> if k == k0 then "selected" =: "selected" else mempty) $ dynText v
  let e = G.uncheckedCastTo HTMLSelectElement $ _el_element eRaw
  performEvent_ $ fmap (Select.setValue e . show) setK
  eChange <- wrapDomEvent e (`on` change) $ do
--    kStr <- fromMaybe "" <$> Select.getValue e
    kStr <- Select.getValue e
    return $ readMay kStr
  let readKey mk = fromMaybe k0 $ do
        k <- mk
        guard $ Data.Map.member k options
        return k
  dValue <- (return . fmap readKey) =<< holdDyn (Just k0) (leftmost [eChange, fmap Just setK])
  return $ Dropdown dValue (fmap readKey eChange) -- @clean this.


-- below this line from the former Estuary.Widgets.Generic

data EditSignal a = ChangeValue a | MakeNew | Close | DeleteMe | RepDiv | MakeGroup | MakeLayer
 | RebuildMe | MakeL3 | MakeL4 | MakeRepOrDiv | Eval | DeleteContainer | LayerSplit | TransformMe deriving (Eq)

instance Functor EditSignal where
  fmap f (ChangeValue x) = ChangeValue $ f x

toPotential::EditSignal a -> Potential a
toPotential (ChangeValue a) = Potential a
toPotential (MakeL3) = PotentialLiveness L3
toPotential (MakeL4) = PotentialLiveness L4
toPotential (Close) = Inert
toPotential (MakeRepOrDiv) = PotentialRepOrDiv
toPotential (MakeGroup) = PotentialMakeGroup
toPotential (MakeLayer) = PotentialMakeLayer
toPotential (DeleteMe) = PotentialDelete

toEditSigGenPat :: EditSignal a -> EditSignal (GeneralPattern a)
toEditSigGenPat (ChangeValue a) = ChangeValue (Atom a Inert Once)
toEditSigGenPat (MakeL4) = MakeL4
toEditSigGenPat (MakeL3) = MakeL3
toEditSigGenPat (MakeNew) =MakeNew
toEditSigGenPat (Close) = Close
toEditSigGenPat (DeleteMe) = DeleteMe
toEditSigGenPat (RepDiv) = RepDiv
toEditSigGenPat (MakeGroup) = MakeGroup
toEditSigGenPat (MakeLayer) = MakeLayer
toEditSigGenPat (RebuildMe) = RebuildMe
toEditSigGenPat (MakeRepOrDiv) = MakeRepOrDiv
toEditSigGenPat (Eval) = Eval
toEditSigGenPat (DeleteContainer) = DeleteContainer
toEditSigGenPat (LayerSplit) = LayerSplit

instance Show a => Show (EditSignal a) where
  show (ChangeValue a) =  show a
  show MakeRepOrDiv = "* or /"
  show Close = "close"
  show DeleteMe = "delete"
  show DeleteContainer ="delete container"
  show MakeGroup = "[  ]"
  show MakeLayer = "[,,]"
  show RebuildMe = "RebuildMe"
  show MakeL3 = "L3"
  show MakeL4 = "L4"
  show Eval = "eval"
  show LayerSplit = "LayerSplit"
  show TransformMe = "Transform"


isChangeValue::EditSignal a -> Bool
isChangeValue (ChangeValue _) = True
isChangeValue _ = False
--data EditSignal = DeleteMe | MakeGroup |

justChangeValues :: EditSignal a -> Maybe a
justChangeValues (ChangeValue x) = Just x
justChangeValues _ = Nothing

clickableDivDynAttrsWChild :: MonadWidget t m => Dynamic t (Map Text Text) -> m a -> m (Event t ()) -- return (Event t (), a)
clickableDivDynAttrsWChild attrs child = do
  (element,_) <- elDynAttr' "div" attrs $ child
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (() <$) clickEv

clickableDivNoClass :: MonadWidget t m => m a -> m (Event t a) -- return (Event t (), a)
clickableDivNoClass child = do
  (element, a) <- el' "div" $ child -- look elAttr' ::
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  let event = (a <$) clickEv
  return event

-- clickableDivWithLabel :: MonadWidget t m => Text -> a -> m (Event t a,  a)
-- clickableDivWithLabel label e = liftM (e <$) $ clickableDivNoClass $ text label

-- clickableA :: MonadWidget t m => Text -> m a -> m (Event t (), a)
-- clickableA label child = liftM (child <$) $ (clickableDivWithLabel $ text label)
   -- return (event, child)
  -- (element, a) <- el' "div" $ child
  -- clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  -- let event = (() <$) clickEv
  -- return $ a


-- clickableDivWithLabel :: MonadWidget t m => m a -> m (Event t ())
-- clickableDivWithLabel child = do
--   (element,_) <- el' "div" $ child
--   clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
--   return $ (() <$) clickEv

-- clickableDiv with class
clickableDiv :: MonadWidget t m => Text -> m a -> m (Event t ())
clickableDiv cssclass child = do
  (element,_) <- elAttr' "div" attr $ child
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (() <$) clickEv
  where
    attr = singleton "class" cssclass

clickableDivClass :: MonadWidget t m => Text -> Text -> m (Event t ())
clickableDivClass label c = do
  (element,_) <- elAttr' "div" (singleton "class" c) $ text label
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (() <$) clickEv

clickableDivClass' :: MonadWidget t m => Text -> Text -> a -> m (Event t a)
clickableDivClass' label c e = liftM (e <$) $ clickableDivClass label c

-- with displayed text that can change
clickableDivClass'':: MonadWidget t m => Dynamic t Text -> Text -> a -> m (Event t a)
clickableDivClass'' label c e = do
  (element, _) <- elAttr' "div" ("class"=:c) $ dynText label
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (e <$) clickEv

mouseOverClickableDiv::MonadWidget t m => Dynamic t Text -> Text -> a -> m(Event t a)
mouseOverClickableDiv label c e = mdo
  (element, _) <- elDynAttr' "div" attrs $ dynText label
  mouseOver <- liftM (True <$) $ wrapDomEvent (_el_element element) (elementOnEventName Mouseover) mouseXY
  mouseOut <- liftM (False <$) $ wrapDomEvent (_el_element element) (elementOnEventName Mouseout) mouseXY
  isMouseOver <- holdDyn False $ leftmost [mouseOut, mouseOver]
  let attrs  = fmap (fromList . (\x-> [("class",c),x]) . ((,) "style") . bool "" ";background-color:rgba(144,238,144,0.2);") isMouseOver
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (e <$) clickEv


clickableDivAttrs::MonadWidget t m => Text -> a -> Map Text Text -> m (Event t a)
clickableDivAttrs label val attrs= do
  (element,_) <- elAttr' "div" attrs $ text label
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (val <$) clickEv

clickableDivAttrs'::MonadWidget t m => Text -> a -> Map Text Text -> x -> y -> m (Dynamic t ((),Event t a))
clickableDivAttrs' label val attrs _ _= do
  (element,_) <- elAttr' "div" attrs $ text label
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  let event = (val <$) clickEv
  return $ constDyn ((),event)

clickableDivDynAttrs :: MonadWidget t m => Text -> a -> Dynamic t (Map Text Text) -> m (Event t a)
clickableDivDynAttrs label val attrs = do
  (element,_) <- elDynAttr' "div" attrs $ text label
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (val <$) clickEv

-- with displayed text that can change
clickableSpanClass:: MonadWidget t m => Dynamic t Text -> Text -> a -> m (Event t a)
clickableSpanClass label c e = do
  (element, _) <- elAttr' "span" ("class"=:c) $ dynText label
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (e <$) clickEv

clickableTdClass::MonadWidget t m => Dynamic t Text -> Dynamic t Text -> a -> m (Event t a)
clickableTdClass label c val = do
  let attrs = fmap (singleton "class") c
  (element, _) <- elDynAttr' "td" attrs $ dynText label
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ ((val) <$) clickEv


pingButton :: MonadWidget t m => Text -> m (Event t ())
pingButton label = liftM (() <$) $ button label

pingButton' :: MonadWidget t m => Text -> m (Dynamic t ((),Event t ()))
pingButton' label = do
  x <- pingButton label
  return $ constDyn ((),x)

pingButton'' :: MonadWidget t m => Text -> a -> b -> m (Dynamic t ((),Event t ()))
pingButton'' label _ _ = pingButton' label

pingButton''':: MonadWidget t m => Text -> Map Text Text -> a -> b -> m (Dynamic t ((),Event t (EditSignal ())))
pingButton''' label attrs _ _ = do
  b <- buttonDynAttrs label (ChangeValue ()) $ constDyn attrs
  return $ constDyn ((), b)

makeNewButton:: (MonadWidget t m)=> Text -> a -> b -> m (Dynamic t ((),Event t (EditSignal ())) )
makeNewButton label _ _ = do
  a <- button label
  return $ constDyn ((), ((MakeNew::EditSignal ()) <$) a)


tdButtonAttrs:: MonadWidget t m => Text -> a -> Map Text Text -> m (Event t a)
tdButtonAttrs s val attrs = do
  (element, _) <- elAttr' "td" attrs $ text s
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ ((val) <$) clickEv

-- with displayed text that can change
tdButtonAttrs':: MonadWidget t m => Dynamic t Text -> a -> Map Text Text -> m (Event t a)
tdButtonAttrs' s val attrs = do
  (element, _) <- elAttr' "td" attrs $ dynText s
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ ((val) <$) clickEv

tdPingButtonAttrs:: MonadWidget t m => Text -> Map Text Text -> a -> b -> m (Dynamic t ((),Event t (EditSignal ())))
tdPingButtonAttrs label attrs _ _ = el "td" $ do
  b <- buttonDynAttrs label (ChangeValue ()) $ constDyn attrs
  return $ constDyn ((), b)

growingTextInput::MonadWidget t m => TextInputConfig t -> m (TextInput t)
growingTextInput config = mdo
  let attrs = _textInputConfig_attributes config
  let dynAttrs = (\m w-> insertWith (T.append) "style" (T.pack $ ";width:"++ show (max 20 $ min 100 $ 8*T.length w) ++ "px" ++";") m) <$> attrs <*> (_textInput_value textField)
  let newConfig = TextInputConfig (_textInputConfig_inputType config) (_textInputConfig_initialValue config) (_textInputConfig_setValue config) dynAttrs
  textField <- textInput newConfig
  return textField

whitespace:: (MonadWidget t m, Show a, Eq a)=> Dynamic t Liveness -> GeneralPattern a -> Text -> [EditSignal (GeneralPattern a)] -> () -> Event t (EditSignal (GeneralPattern a)) -> m (Dynamic t ((), Event t (EditSignal (GeneralPattern a)), Event t Hint))
whitespace liveness iVal cssClass popupList _ event = elAttr "div" ("style"=:"position:relative;display:inline-block") $ elClass "div" cssClass $ mdo
  -- whitespace <- clickableDivClass'' (constDyn (case iVal of (Layers _ _)->",    ";otherwise->"     ")) "whiteSpaceClickable" ()
  whitespace <- mouseOverClickableDiv (constDyn (case iVal of (Layers _ _)->",    ";otherwise->"     ")) "whiteSpaceAdd" ()
  openCloseEvents <- toggle False $ leftmost [whitespace, closeEvents,(() <$) addEvent]
  popupMenu <- liftM (switchPromptlyDyn) $ flippableWidget (return never) (whitespacePopup liveness popupList) False (updated openCloseEvents)
  let addEvent = (ChangeValue (Blank Inert) <$) $ ffilter (\x-> if isJust x then fromJust (fmap (isChangeValue) x) else False) popupMenu
  let livenessEv = fmap fromJust $ ffilter (\x-> x==Just MakeL3 || x == Just MakeL4 || x == Just Eval) popupMenu
  let delContEv = fmap fromJust $ ffilter (\x-> x==Just DeleteContainer) popupMenu
  let layerSplit = fmap fromJust $ ffilter (\x-> x==Just LayerSplit) popupMenu
  let closeEvents = (() <$) $ ffilter (==Nothing) popupMenu
  return $ constDyn ((),leftmost [livenessEv, addEvent,delContEv,layerSplit],never)
  --where
  --  iValSingle (Group (Live (xs,r) _) p) = iValSingle (xs!!0)
  --  iValSingle (Group (Edited _ (xs,r)) p) = iValSingle (xs!!0)
  --  iValSingle (Layers (Live (xs,r) _) p) = iValSingle (xs!!0)
  --  iValSingle (Layers (Edited _ (xs,r)) p) = iValSingle (xs!!0)
  --  iValSingle (Atom x p r) = Atom x p r



whitespacePopup::(MonadWidget t m,Show a)=> Dynamic t Liveness -> [EditSignal a]  -> m (Event t (Maybe (EditSignal a)))
whitespacePopup liveness actionList = elClass "div" "popupMenu" $ do
  let popupList = fmap (\x->clickableDivClass' (T.pack $ show x) "primary-color code-font background" (Just x)) actionList -- [m (Maybe (EditSignal))]
  let events = Control.Monad.sequence popupList  -- m (t a)
  events' <- liftM (id) events
  layerSplit <- clickableDivClass' "[ , ]" "primary-color code-font background" (LayerSplit)
  liveWidget <- livenessCheckboxWidget (liveness)
  closeMenu <- clickableDivClass' "close" "primary-color code-font background" (Nothing)
  return $ leftmost $ events' ++[closeMenu, fmap Just liveWidget, fmap Just layerSplit]


livenessWidget::(MonadWidget t m) =>  Dynamic t Liveness -> m (Event t (EditSignal a))
livenessWidget liveness = elClass "div" "livenessWidget" $ mdo
  let livenessText = fmap (\x->if x==L3 then "L3" else "L4") liveness
  livenessButton <- clickableDivClass'' (livenessText) "livenessText" ()
  eval <- clickableDivClass' "Eval" "L3Eval" Eval
  let livenessChange = attachWith (\d e -> if d==L4 then MakeL3 else MakeL4) (current liveness) livenessButton
  return $ leftmost [livenessChange,eval]

livenessCheckboxWidget::(MonadWidget t m ) => Dynamic t Liveness -> m (Event t (EditSignal a))
livenessCheckboxWidget liveness = elClass "div" "livenessWidget" $ do
  text "Live"
  let isLive = fmap (==L4) liveness
  cb <- checkboxView (constDyn Data.Map.empty) isLive
  eval <- clickableDivClass' "Eval" "L3Eval" Eval
  return $ leftmost [fmap (\x-> if x then MakeL4 else MakeL3) cb,eval]

basicPopup::(MonadWidget t m,Show a)=> Dynamic t Liveness -> [EditSignal a]  -> m (Event t (Maybe (EditSignal a)))
basicPopup liveness actionList = elClass "div" "popupMenu" $ do
  let popupList = fmap (\x->clickableDivClass' (T.pack $ show x) "primary-color code-font background" (Just x)) actionList -- [m (Maybe (EditSignal))]
  let events = Control.Monad.sequence popupList  -- m (t a)
  events' <- liftM (id) events
  liveWidget <- livenessCheckboxWidget (liveness)
  closeMenu <- clickableDivClass' "close" "primary-color code-font background" (Nothing)
  return $ leftmost $ events' ++[closeMenu, fmap Just liveWidget]

samplePickerPopup::(MonadWidget t m)=>  Dynamic t Liveness -> Map Int (Text,Text) -> [EditSignal  Text] -> m (Event t (Maybe (EditSignal Text)),Event t Hint)
samplePickerPopup liveness sampleMap actionList  = elClass "div" "popupMenu" $ do
  dd <- dropdownOpts (-1) sampleMap def  --defaults to -1 so that someone can select "~" (the first one) and have it register as a change
  let sampleKey = _dropdown_value dd
  let sampleChange = fmap (\x-> maybe ("~") (snd) $ Data.Map.lookup x sampleMap) sampleKey -- Dyn (editsignal Text)
  let popupList = fmap (\x->clickableDivClass' (T.pack $ show x) "primary-color code-font background" (Just x)) actionList -- [m (Maybe (EditSignal))]
  let events = Control.Monad.sequence popupList  -- m (t a)
  events' <- liftM (id) events
  liveWidget <- livenessCheckboxWidget liveness
  closeMenu <- clickableDivClass' "close" "primary-color code-font background" (Nothing)
  return $ (leftmost $ events' ++[closeMenu, fmap Just liveWidget,fmap (Just . ChangeValue) (updated sampleChange)], fmap SampleHint $ ffilter (\x->if x =="~" then False else True) $ updated sampleChange)

repDivWidget'::MonadWidget t m => RepOrDiv -> Event t () -> m (Event t RepOrDiv)
repDivWidget' iVal _ = elClass "span" "repOrDiv" $ mdo
  repDivButton <- clickableSpanClass showRep "repDivSpan" ()
  repTog <- toggle iToggle repDivButton
  let showRep = fmap (\x-> if x then " * " else " / ") repTog
  let textAttrs = constDyn $ fromList $ zip ["min", "class"] ["1","repOrDivInput"]
  textField <- textInput $ def & textInputConfig_attributes .~ textAttrs & textInputConfig_initialValue .~ (T.pack $ show iNum) & textInputConfig_inputType .~"number"
  let numTextField = _textInput_value textField
  let num = fmap (\str-> if isJust (readMaybe (T.unpack str)::Maybe Int) then (read (T.unpack str)::Int) else iNum) numTextField
  let dynVal = (\tog val -> if tog then Rep val else Div val) <$> repTog <*> num
  return $ updated dynVal
  where
    (iToggle, iNum) = case iVal of
      (Rep x) -> (True,x)
      (Div x) -> (False,x)
      otherwise -> (True, 1)

repDivWidget''::MonadWidget t m => RepOrDiv -> Event t () -> m (Dynamic t RepOrDiv)
repDivWidget'' iVal _ = elClass "span" "repOrDiv" $ mdo
  repDivButton <- clickableSpanClass showRep "repDivSpan" ()
  repTog <- toggle iToggle repDivButton
  let showRep = fmap (\x-> if x then " * " else " / ") repTog
  let textAttrs = constDyn $ fromList $ zip ["min", "class"] ["1","repOrDivInput"]
  textField <- textInput $ def & textInputConfig_attributes .~ textAttrs & textInputConfig_initialValue .~ (T.pack $ show iNum) & textInputConfig_inputType .~"number"
  let numTextField = _textInput_value textField
  let num = fmap (\str-> if isJust (readMaybe (T.unpack str)::Maybe Int) then (read (T.unpack str)::Int) else iNum) numTextField
  return $ (\tog val -> if tog then Rep val else Div val) <$> repTog <*> num
  where
    (iToggle, iNum) = case iVal of
      (Rep x) -> (True,x)
      (Div x) -> (False,x)
      otherwise -> (True, 1)


genericSignalMenu :: MonadWidget t m => m (Event t (Maybe (EditSignal a)))
genericSignalMenu = elAttr "div" (singleton "style" "top: 0px; left: 0px; position: absolute; z-index: 1;") $ do
  a <- clickableDivClass' "Close" "primary-color code-font background" Nothing
  b <- clickableDivClass' "-" "primary-color code-font background" (Just DeleteMe)
  c <- clickableDivClass' "[]" "primary-color code-font background" (Just MakeGroup)
  d <- clickableDivClass' "{}" "primary-color code-font background" (Just MakeLayer)
  return $ leftmost [a,b,c,d]

popupSignalWidget :: MonadWidget t m => m (Event t (EditSignal a))
popupSignalWidget = elAttr "div" (singleton "style" "border: 1px solid black; position: relative; display: inline-block;") $ mdo
  y <- popup popupEvents
  x <- clickableWhiteSpace
  let popupEvents = leftmost [Just genericSignalMenu <$ x,Nothing <$ y]
  return $ (fmap fromJust . ffilter isJust) y

genericSignalWidget :: MonadWidget t m => m (Event t (EditSignal a))
genericSignalWidget = elClass "div" "genericSignalWidget" $ do
  b <- button' "-" DeleteMe
  c <- button' "[]" MakeGroup
  d <- button' "{}" MakeLayer
  return $ leftmost [b,c,d]

-- Used heavily in Help section
-- Contains the child in a hideable div with a class
hideableWidget :: MonadWidget t m => Dynamic t Bool -> Text -> m a -> m a
hideableWidget b c m = do
  let attrs = fmap (bool (fromList [("hidden","true"),("class",c)]) (singleton "class" c)) b
  elDynAttr "div" attrs m

-- Used for the terminal
-- Contains the child in a hideable div with no class
hideableWidget' :: MonadWidget t m => Dynamic t Bool -> m a -> m a
hideableWidget' b m = do
  let attrs = fmap (bool (fromList [("hidden","true")]) (fromList [("visible","true")])) b
  elDynAttr "div" attrs m

hideableWidgetWFlexColumn :: MonadWidget t m => Dynamic t Bool -> m a -> m a
hideableWidgetWFlexColumn b  m = do
  let attrs = fmap (bool (fromList [("hidden","true")]) (fromList [("style", "display: flex; flex-direction: column;")])) b
  elDynAttr "div" attrs m

traceDynamic :: (MonadWidget t m, Show a) => String -> Dynamic t a -> m (Dynamic t a)
traceDynamic m x = do
  initialValue <- sample $ current x
  let x' = traceEvent m $ updated x
  holdDyn initialValue x'

-- a hideable widget that is only built/rebuilt when it is made visible
deferredWidget :: (MonadFix m, DomBuilder t m, MonadSample t m, MonadHold t m, Adjustable t m, NotReady t m, PostBuild t m) => Text -> Dynamic t Bool -> Dynamic t (m ()) -> m ()
deferredWidget cssClass isVisible dynWidgets = do
  initialVisibility <- sample $ current isVisible
  defaultWidget <- sample $ current dynWidgets
  let initialWidget = if initialVisibility then defaultWidget else return ()
  isVisible' <- holdUniqDyn isVisible
  let transitionsToVisible = ffilter (== True) $ updated isVisible'
  let becomesVisible = tag (current dynWidgets) transitionsToVisible
  let visibleChanges = gate (current isVisible) $ updated dynWidgets
  let changes = leftmost [becomesVisible,visibleChanges]
  let attrs = fmap (bool (fromList [("hidden","true"),("class",cssClass)]) (singleton "class" cssClass)) isVisible
  elDynAttr "div" attrs $ widgetHold initialWidget changes
  return ()

--this is a special type of tooltip that is used in statusWidget, tooltip has position relative
tooltipForScrollableTable :: DomBuilder t m => m a -> m b -> m a
tooltipForScrollableTable child popup = do
  divClass "tooltip-scrollable-table" $ do
    a <- child
    elClass "span" "tooltiptext-scrollable-table" popup
    return a

-- this is a standard tooltip that "overrides" the overflow hidden of its parents.
--this won't work fine if the label is inside a scrollable div.
tooltip :: DomBuilder t m => m a -> m b -> m a
tooltip child popup = do
  elClass "div" "tooltip" $ do
    a <- child
    divClass "tooltipPosAbsolute" $ elClass "span" "tooltiptext code-font" popup
    return a

-- a tooltip with settable class for the popup
tooltipNoPopUpClass :: DomBuilder t m => m a -> m b -> m a
tooltipNoPopUpClass child popup = do
  elClass "div" "tooltip" $ do
    a <- child
    divClass "tooltipPosAbsolute" $ popup
    return a


-- below this line is the former Estuary.Reflex.Container


widgetMap :: (MonadWidget t m,Ord k) => Map k (m a) -> Event t (Map k (m a)) -> m (Dynamic t (Map k a))
widgetMap iMap rebuild = do
  let iWidget = sequence $ elems iMap -- :: m [a]
  let rebuild' = fmap (sequence . elems) rebuild -- :: Event t (m [a])
  widgets <- widgetHold iWidget rebuild' -- :: m (Dynamic t [a])
  keys <- holdDyn (keys iMap) (fmap keys rebuild) -- :: m (Dynamic t [k])
  return $ (\a b -> fromList $ zip a b) <$> keys <*> widgets

container' :: (Ord k, Num k, MonadWidget t m)
  => (v -> m a) -- a builder function from
  -> Map k v -- an initial map of values
  -> Event t (Map k (Construction v)) -- construction events
  -> m (Dynamic t (Map k a))

container' build iMap cEvents = do
  let iMap' = fmap build iMap
  newMap <- foldDyn (\a b -> applyConstructionMap b a) iMap cEvents
  let newMap' = fmap (fmap build) (updated newMap)
  widgetMap iMap' newMap'


data Construction a = Insert a | Replace a | Delete deriving (Show)

-- given a Map and a Construction operation at a specifed key, return the new map

applyConstruction :: (Num k, Ord k) => Map k a -> (k,Construction a) -> Map k a
applyConstruction m (k,Replace a) = Data.Map.insert k a m
applyConstruction m (k,Delete) = Data.Map.delete k m
applyConstruction m (k,Insert a) = Data.Map.insert k a m'
  where m' = mapKeys (f) m
        f x | member k m = if (x>=k) then (x + 1) else x
            | otherwise = x

-- given a Map and another map of Construction operations, return the resulting map

applyConstructionMap :: (Num k, Ord k) => Map k a -> Map k (Construction a) -> Map k a
applyConstructionMap oldMap cMap = foldlWithKey (\a k b -> applyConstruction a (k,b)) oldMap cMap


-- given a Map and another map of Construction operations, determine the complete
-- list of "construction" events as expected by the Reflex function listHoldWithKey

constructionDiff :: (Num k, Ord k, Eq v) => Map k v -> Map k (Construction v) -> Map k (Maybe v)
constructionDiff oldMap cMap = unions [deletions,additions,changes]
  where newMap = applyConstructionMap oldMap cMap
        deletions = fmap (const Nothing) $ Data.Map.difference oldMap newMap -- keys only in oldMap are deletions
        additions = fmap (Just) $ Data.Map.difference newMap oldMap -- keys only in newMap are additions
        changes = fmap (Just) $ intersection newMap $ Data.Map.filter (id) $ intersectionWith (/=) oldMap newMap

container :: (Ord k, Num k, Show k, Eq v, Show v, MonadWidget t m)
   => Map k v                                -- a map of initial values
   -> Event t (Map k (Construction v))       -- construction events (replace/insert/delete)
   -> Event t (Map k w)                      -- signaling events to be delivered to child widgets
   -> (v -> Event t w -> m (Dynamic t (v,Event t x)))                -- function to make a widget given initial value and signaling event
   -> m ( (Dynamic t (Map k v)) , Event t (Map k x) )

container initialValue cEvents rEvents mkChild = mdo
  let cEventsIn = cEvents
  let existingMap' = values
  let cEvents' = attachPromptlyDynWith (constructionDiff) existingMap' cEventsIn
  let selector = fanMap rEvents
  let mkChild' k v = mkChild v $ select selector $ (Const2 k)
  widgets <- liftM (joinDynThroughMap) $ listHoldWithKey initialValue cEvents' mkChild' -- Dynamic t (Map k (v,Event t x))
  let values = fmap (fmap (fst)) widgets
  let events = switchPromptlyDyn $ fmap (mergeMap . fmap (snd)) widgets
  return (values,events)


eitherContainer :: (Ord k, Num k, Show k, Eq v, Eq a, MonadWidget t m)
   => Map k (Either v a)                               -- a map of initial values
   -> Event t (Map k (Construction (Either v a)))       -- construction events (replace/insert/delete)
   -> Event t (Map k w)                                -- signaling events to be delivered to child widgets of type v
   -> Event t (Map k b)                                -- signaling events to be delivered to child widgets of type a
   -> (v -> Event t w -> m (Dynamic t (v,Event t e)))  -- function to build widgets for type v (returning events of type e)
   -> (a -> Event t b -> m (Dynamic t (a,Event t e)))  -- function to build widgets for type a (also returning events of type e)
   -> m ( (Dynamic t (Map k (Either v a))) , Event t (Map k e) )

eitherContainer initialValues cEvents eventsToLeft eventsToRight buildLeft buildRight = mdo
  let cEvents' = attachPromptlyDynWith (constructionDiff) values cEvents
  widgets <- liftM (joinDynThroughMap) $ listHoldWithKey initialValues cEvents' mkChild
  let values = fmap (fmap (fst)) widgets
  let events = switchPromptlyDyn $ fmap (mergeMap . fmap (snd)) widgets
  return (values,events)
  where
    mkChild k (Left x) = buildLeft x (select (fanMap eventsToLeft) (Const2 k)) >>= return . fmap (\(v,e)->(Left v,e))
    mkChild k (Right x) = buildRight x (select (fanMap eventsToRight) (Const2 k)) >>= return . fmap (\(a,e)->(Right a,e))


-- for widgets returning a 3rd event channel (for hints)
eitherContainer4 :: (Ord k, Num k, Show k, Eq v, Eq a, MonadWidget t m)
   => Map k (Either v a)                               -- a map of initial values
   -> Event t (Map k (Construction (Either v a)))       -- construction events (replace/insert/delete)
   -> Event t (Map k w)                                -- signaling events to be delivered to child widgets of type v
   -> Event t (Map k b)                                -- signaling events to be delivered to child widgets of type a
   -> (v -> Event t w -> m (Dynamic t (v,Event t e,Event t e1)))  -- function to build widgets for type v (returning events of type e)
   -> (a -> Event t b -> m (Dynamic t (a,Event t e,Event t e1)))  -- function to build widgets for type a (also returning events of type e)
   -> m ( (Dynamic t (Map k (Either v a))) , Event t (Map k e) , Event t e1 )

eitherContainer4 initialValues cEvents eventsToLeft eventsToRight buildLeft buildRight = mdo
  let cEvents' = attachPromptlyDynWith (constructionDiff) values cEvents
  widgets <- liftM (joinDynThroughMap) $ listHoldWithKey initialValues cEvents' mkChild -- m (Dynamic t (Map k a))
  let values = fmap (fmap (\(a,_,_)->a)) widgets
  let events = switchPromptlyDyn $ fmap (mergeMap . fmap ((\(_,b,_)->b))) widgets
  let events2 = switchPromptlyDyn $ fmap (leftmost . elems . fmap ((\(_,_,c)->c))) widgets -- @ may drop some messages if multiple hints coincide...
  return (values,events,events2)
  where
    mkChild k (Left x) = buildLeft x (select (fanMap eventsToLeft) (Const2 k)) >>= return . fmap (\(v,e,e2)->(Left v,e,e2))
    mkChild k (Right x) = buildRight x (select (fanMap eventsToRight) (Const2 k)) >>= return . fmap (\(a,e,e2)->(Right a,e,e2))



-- Same as eitherContainer' but children take Dynamic value too
-- primarily (/for now) used for updating children with liveness values
--eitherContainerLive :: (Ord k, Num k, Show k, Eq v, Eq a, MonadWidget t m)
--   => Map k (Either v a)                               -- a map of initial values
--   -> Event t (Map k (Construction (Either v a)))       -- construction events (replace/insert/delete)
--   -> Dynamic t c
--   -> Event t (Map k w)                                -- signaling events to be delivered to child widgets of type v
--   -> Event t (Map k b)                                -- signaling events to be delivered to child widgets of type a
--   -> (Dynamic t c -> v -> Event t w -> m (Dynamic t (v,Event t e)))  -- function to build widgets for type v (returning events of type e)
--   -> (Dynamic t c -> a -> Event t b -> m (Dynamic t (a,Event t e)))  -- function to build widgets for type a (also returning events of type e)
--   -> m ( (Dynamic t (Map k (Either v a))) , Event t (Map k e) )

--eitherContainerLive initialValues cEvents liveness eventsToLeft eventsToRight buildLeft buildRight = mdo
--  let cEvents' = attachDynWith (constructionDiff) values cEvents
--  widgets <- liftM (joinDynThroughMap) $ listHoldWithKey initialValues cEvents' mkChild
--  values <- mapDyn (fmap (fst)) widgets
--  events <- liftM (switchPromptlyDyn) $ mapDyn (mergeMap . fmap (snd)) widgets
--  return (values,events)
--  where
--    mkChild k (Left x) = buildLeft liveness x (select (fanMap eventsToLeft) (Const2 k)) >>= mapDyn (\(v,e)->(Left v,e))
--    mkChild k (Right x) = buildRight liveness x (select (fanMap eventsToRight) (Const2 k)) >>= mapDyn (\(a,e)->(Right a,e))

{- ???
maybeContainer :: (Ord k, Num k, Show k, Eq v, Eq a, MonadWidget t m)
   => Map k (Maybe v)                               -- a map of initial values
   -> Event t (Map k (Construction (Maybe v))       -- construction events (replace/insert/delete)
   -> Event t (Map k w)                             -- signaling events to be delivered to child widgets of type v
   -> (v -> Event t w -> m a)                       -- function to build widgets for Just values
   -> (Event t w -> m b)                            -- function to build widgets for Nothing values
   -> m (Dynamic t (Map k a))

widgetAndSpace ::
  => (v -> Event t w -> m a)
  -> m (Dynamic t a,)

-}


-- eitherContainer' is a variant of eitherContainer where the difference is that
-- only left values (not right) are included in the dynamic result:

eitherContainer' :: (Ord k, Num k, Show k, Eq v, Eq a, MonadWidget t m)
   => Map k (Either v a)                               -- a map of initial values
   -> Event t (Map k (Construction (Either v a)))      -- construction events (replace/insert/delete)
   -> Event t (Map k w)                                -- signaling events to be delivered to child widgets of type v
   -> Event t (Map k b)                                -- signaling events to be delivered to child widgets of type a
   -> (v -> Event t w -> m (Dynamic t (v,Event t e)))  -- function to build widgets for type v (returning events of type x)
   -> (a -> Event t b -> m (Dynamic t (a,Event t e)))  -- function to build widgets for type a (returning events of type c)
   -> m ( (Dynamic t (Map k v)) , Event t (Map k e) )
eitherContainer' initialValues cEvents eventsToLeft eventsToRight buildLeft buildRight = do
  (d,e) <- eitherContainer initialValues cEvents eventsToLeft eventsToRight buildLeft buildRight
  let d' = fmap (Data.Map.mapMaybe (either (Just) (const Nothing))) d
  return (d',e)


eitherContainer'' :: (Ord k, Num k, Show k, Eq v, Eq a, MonadWidget t m)
   => Map k (Either v a)                               -- a map of initial values
   -> Event t (Map k (Construction (Either v a)))       -- construction events (replace/insert/delete)
   -> Event t (Map k w)                                -- signaling events to be delivered to child widgets of type v
   -> Event t (Map k b)                                -- signaling events to be delivered to child widgets of type a
   -> (v -> Event t w -> m (Dynamic t (v,Event t e,Event t h)))  -- function to build widgets for type v (returning events of type e and f)
   -> (a -> Event t b -> m (Dynamic t (a,Event t e,Event t h)))  -- function to build widgets for type a (also returning events of type e and f)
   -> m ( (Dynamic t (Map k (Either v a))) , Event t (Map k e), Event t h)

eitherContainer'' initialValues cEvents eventsToLeft eventsToRight buildLeft buildRight = mdo
  let cEvents' = attachPromptlyDynWith (constructionDiff) values cEvents
  widgets <- liftM (joinDynThroughMap) $ listHoldWithKey initialValues cEvents' mkChild
  let values = fmap (fmap (\(x,_,_) -> x)) widgets
  let eEvents = switchPromptlyDyn $ fmap (mergeMap . fmap (\(_,x,_) -> x)) widgets
  let hEvents = switchPromptlyDyn $ fmap (leftmost . elems . fmap (\(_,_,x) -> x)) widgets
  return (values,eEvents,hEvents)
  where
    mkChild k (Left x) = buildLeft x (select (fanMap eventsToLeft) (Const2 k)) >>= return . fmap (\(v,e,f)->(Left v,e,f))
    mkChild k (Right x) = buildRight x (select (fanMap eventsToRight) (Const2 k)) >>= return . fmap (\(a,e,f)->(Right a,e,f))

eitherContainer''' :: (Ord k, Num k, Show k, Eq v, Eq a, MonadWidget t m)
   => Map k (Either v a)                               -- a map of initial values
   -> Event t (Map k (Construction (Either v a)))      -- construction events (replace/insert/delete)
   -> Event t (Map k w)                                -- signaling events to be delivered to child widgets of type v
   -> Event t (Map k b)                                -- signaling events to be delivered to child widgets of type a
   -> (v -> Event t w -> m (Dynamic t (v,Event t e,Event t h)))  -- function to build widgets for type v (returning events of type e and f)
   -> (a -> Event t b -> m (Dynamic t (a,Event t e,Event t h)))  -- function to build widgets for type a (returning events of type e and f)
   -> m ( Dynamic t (Map k v) , Event t (Map k e), Event t h)
eitherContainer''' initialValues cEvents eventsToLeft eventsToRight buildLeft buildRight = do
  (d,e,h) <- eitherContainer'' initialValues cEvents eventsToLeft eventsToRight buildLeft buildRight
  let d' = fmap (Data.Map.mapMaybe (either (Just) (const Nothing))) d
  return (d',e,h)


{-
eitherContainer'' :: (Ord k, Num k, Show k, Eq v, Eq a, MonadWidget t m)
  => Map k (Either v a)
  -> Event t (Map k (Construction (Either v a)))
  -> (v -> m (Dynamic t (v,Event t e)))
  -> (a -> m (Event t c))
  -> m ( Dynamic t (Map k v), Event t (Map k e), Event t (Map k c) )

eitherContainer'' i cEvents lBuild rBuild = mdo
  widgets <- listHoldWithKey i cEvents? build -- m (Dynamic t (Map k (Either (Dynamic t (v,Event t e)) (Event t c))))
  values <- liftM joinDynThroughMap $ forDyn widgets (fmapFstIntoMap  . filterMapForOnlyLeftElements)
  lEvents <- forDyn widgets (fmapSndIntoMap  .  filterMapForOnlyLeftElements)
  rEvents <- forDyn widgets

  widgets <- liftM (joinDynThroughMap) $ listHoldWithKey i cEvents' build
  values <- mapDyn (fmap (fst)) widgets
  events <- liftM (switchPromptlyDyn) $ mapDyn (mergeMap . fmap (snd)) widgets
  return (values,lEvents,rEvents)
  where
    build _ (Left v) = lBuild v >>= mapDyn (\(v,e)-> Left (v,e))
    build _ (Right a) = rBuild a >>= mapDyn (\c-> Right c)
-}

eitherWidget :: (MonadWidget t m)
  => (a -> Event t c -> m (Dynamic t (a,Event t d)))
  -> (b -> Event t c -> m (Dynamic t (b,Event t d)))
  -> Either a b -> Event t c -> m (Dynamic t ((Either a b),Event t d))

eitherWidget buildA buildB iValue c = either buildA' buildB' iValue
  where
    buildA' a = buildA a c >>= return . fmap (\(x,d) -> (Left x,d))
    buildB' b = buildB b c >>= return . fmap (\(x,d) -> (Right x,d))

wfor :: (MonadWidget t m) => [a] -> (a -> m (Dynamic t b)) -> m (Dynamic t [b])
wfor iVals mkChild = do
  widgets <- liftM (joinDynThroughMap) $ listHoldWithKey iMap never mkChild' -- m (Dynamic t [b]))
  return $ fmap elems widgets
  where
    iMap = fromList $ zip [(0::Int)..] iVals
    mkChild' _ a = mkChild a

wmap :: (MonadWidget t m) => (a -> m (Dynamic t b)) -> [a] -> m (Dynamic t [b])
wmap = flip wfor


resettableWidget :: MonadWidget t m => (a -> Event t b -> m (Dynamic t c)) -> a -> Event t b -> Event t a -> m (Dynamic t c)
resettableWidget f i e reset = liftM (join) $ widgetHold (f i e) $ fmap (\x -> f x e) reset


popup :: MonadWidget t m => Event t (Maybe (m (Event t a))) -> m (Event t a)
popup buildEvents = do
  let buildEvents' = fmap (maybe (return never) id) buildEvents
  liftM (switchPromptlyDyn) $ widgetHold (return never) buildEvents'


clickableWhiteSpace :: MonadWidget t m => m (Event t ())
clickableWhiteSpace = do
  (element,_) <- elAttr' "div" (singleton "class" "clickableWhiteSpace") $ text "clickableWhiteSpace"
  clickEv <- wrapDomEvent (_el_element element) (elementOnEventName Click) (mouseXY)
  return $ (() <$) clickEv

flippableWidget :: MonadWidget t m => m a -> m a -> Bool -> Event t Bool -> m (Dynamic t a)
flippableWidget b1 b2 i e = widgetHold (bool b1 b2 i) $ fmap (bool b1 b2) e
