-- This module could potentially be rewritten and heavily simplified once the
-- custom context menu spec in HTML 5.1 is adopted by all major browsers. At
-- time of writing the spec is only a recommendation and only implemented by
-- Mozilla Firefox.

module ContextMenu where

import           ContextMenu.Style
import           ContextMenu.Util
import           Control.Monad               (when)
import qualified Graphics.UI.Threepenny      as UI
import           Graphics.UI.Threepenny.Core

-- |A menu item is some text to be displayed and either UI actions to execute or
-- a nested menu.
data MenuItem a = MenuItem { mIText :: String, mIValue :: MenuItemValue a }
data MenuItemValue a = MenuItemActions [Action] | NestedMenu [MenuItem a]

-- |Constructor for a menu item that contains UI actions to execute.
actionMenuItem :: String -> [Action] -> MenuItem a
actionMenuItem text actions =
    MenuItem { mIText = text, mIValue = MenuItemActions actions }

-- |Constructor for a menu item that contains a nested menu.
nestedMenuItem :: String -> [MenuItem a] -> MenuItem a
nestedMenuItem text nested =
    MenuItem { mIText = text ++ "  ›", mIValue = NestedMenu nested }

-- |Creates a custom context menu and attaches it to a given element. Prevents
-- the default context menu from occuring.
contextMenu :: [MenuItem a] -> Element -> UI ()
contextMenu items sourceEl = do
    contextMenuEls <- contextMenu' items sourceEl
    element sourceEl #+ contextMenuEls
    preventDefaultContextMenu sourceEl

-- |Attaches a custom context menu to an element.
contextMenu' :: [MenuItem a] -> Element -> UI [Action]
contextMenu' items sourceEl = do
    rmTargetEl <- UI.div # set style rmTargetStyle
    let closeRmTarget = dimensions "0" "0" rmTargetEl
    (menuEl, closeMenu, closeNestedMenus) <- newMenu [closeRmTarget] items
    -- Display menu on a contextmenu event.
    on UI.contextmenu sourceEl $ \(x, y) ->
        displayAt x y menuEl >> dimensions "100vw" "100vh" rmTargetEl
    -- Hide everything on rmTarget click.
    on UI.mousedown rmTargetEl $ const $
        closeRmTarget >> closeMenu >> sequence closeNestedMenus
    -- Hide nested menus on hover over rmTarget.
    on UI.hover rmTargetEl $ const $ sequence closeNestedMenus
    return [element rmTargetEl, element menuEl]

-- |Returns a menu element, an action to close the menu and actions to close any
-- nested menus.
newMenu :: [Action] -> [MenuItem a] -> UI (Element, Action, [Action])
newMenu closeParents menuItems = do
    menuEl <- UI.li # set style menuStyle
    let closeMenu = display "none" menuEl
    -- Menu items as elements and respective list of actions to close nested
    -- menus. :: UI [(Element, [Action])]
    menuItemEls <- mapM (menuItem $ closeParents ++ [closeMenu]) menuItems
    element menuEl #+ map (element . fst) menuItemEls
        -- On hover over a menu item we want close any nested menus from
        -- *other* menu items.
    let closeOtherMenusOnHover ((el1, _), i1) xs =
          on UI.hover el1 $ const $ do
              let closeIfNotSelf ((_, closeEl2), i2) =
                    when (i1 /= i2) (sequence_ closeEl2)
              mapM closeIfNotSelf xs
    mapPairsWithIndex menuItemEls closeOtherMenusOnHover
    return (menuEl, closeMenu, concat (map snd menuItemEls))

-- |Returns a menu item element and actions to open and close it.
menuItem :: [Action] -> MenuItem a -> UI (Element, [Action])
menuItem closeAbove (MenuItem text value) = do
    menuItemEl <- UI.li # set UI.text text # set style menuItemStyle
    highlightWhileHover menuItemEl
    case value of
        MenuItemActions actions -> do
            -- On click execute the actions and close the entire menu.
            on UI.click menuItemEl $ const $ do
                sequence_ $ closeAbove ++ actions
                liftIO $ putStrLn "event clicked"
            return (menuItemEl, [])
        NestedMenu nestedMenuItems -> do
            (nestedMenuEl, closeMenu, closeNestedMenu)
                 <- newMenu closeAbove nestedMenuItems
            -- Position a nested menu relative to this menu item.
            element menuItemEl # set UI.position "relative"
            element nestedMenuEl # set UI.position "absolute" # set UI.right "0px" # set UI.top "0px"
            element menuItemEl #+ [element nestedMenuEl]
            -- On hover display the nested menu.
            on UI.hover menuItemEl $ const $ display "block" nestedMenuEl
            return (menuItemEl, [closeMenu] ++ closeNestedMenu)

-- |Highlight a given element while it is hovered over.
highlightWhileHover :: Element -> UI ()
highlightWhileHover el = whileHover el
    (element el # set style [("background-color", "#DEF"   )])
    (element el # set style [("background-color", "inherit")])

-- |CSS class used to identify elements on which to prevent a default context
-- menu from opening.
preventDefaultClass = "__prevent-default-context-menu"

-- |Prevents a default context menu opening from the given element.
preventDefaultContextMenu :: Element -> UI ()
preventDefaultContextMenu el = do
    element el # set UI.class_ preventDefaultClass
    runFunction $ ffi "$(%1).bind('contextmenu', e => e.preventDefault())"
                      ("." ++ preventDefaultClass)