import "Simantics/DB"
import "Comparator"
import "Map" as Map
include "Simantics/Testing/BuiltinKeys" as BuiltinKeys
import "Simantics/Testing/BrowseContext"
import "Simantics/Ontologies"

importJava "org.eclipse.jface.action.Action" where
    data Action
    
    @JavaName getText
    getActionText :: Action -> <Proc> String
    
    @JavaName getId
    getActionId :: Action -> <Proc> String

importJava "org.simantics.modeling.ui.actions.ModeledActions" where
    """
    Comparator for comparing Actions together. Handy for sorting
    """
    ACTION_COMPARATOR :: Comparator Action

instance Eq Action where
    a == b = compareWithComparator ACTION_COMPARATOR a b == 0

instance Ord Action where
    compare = compareWithComparator ACTION_COMPARATOR

importJava "org.simantics.browsing.ui.model.actions.IActionCategory" where
    """
    Interface for storing Actions with ActionCategories
    """
    data IActionCategory
    
    @JavaName getLabel
    """
    Gives the label of the ActionCategory e.g. `New` or `Edit`
    """
    getIActionCateogryLabel :: IActionCategory -> <Proc> String
    
    @JavaName getPriority
    """
    Gives the priority of the current ActionCategory
    """
    getIActionCategoryPriority :: IActionCategory -> <Proc> Double
    
    @JavaName isSubmenu
    """
    Boolean value indicating if the category has submenu or not
    """
    isIActionCategorySubmenu :: IActionCategory -> <Proc> Boolean

importJava "org.simantics.browsing.ui.model.actions.ActionBrowseContext" where
    """
    ActionBrowseContext holds all contributions related to given set of action browse contexts.
    """
    data ActionBrowseContext
    
    """
    Gets all the actions for the given NodeContext
    """
    getActions :: ActionBrowseContext -> NodeContext -> [NodeContext] -> <ReadGraph> Map.T IActionCategory [Action]
    @private
    create :: [Resource] -> <ReadGraph> ActionBrowseContext

importJava "org.simantics.browsing.ui.model.browsecontexts.BrowseContexts" where
    toActionBrowseContextG :: Vector String -> <ReadGraph> ActionBrowseContext

"""
Creates a new ActionBrowseContext for the given Collection of Resources.
"""
createActionBrowseContext :: [Resource] -> <ReadGraph> ActionBrowseContext
createActionBrowseContext resource = do
    create resource

"""
Test function for browsing whole BrowseContext for all NodeContexts recursively. Also goes through ActionBrowseContexts
"""
browseAllContext :: BrowseContext -> NodeContext -> <Proc> ()
browseAllContext browse node = do
    children = syncRead $ \_ -> browseContextChildren browse node
    lista = collectionToList children
    if length lista > 0
    then do
        all = browseAllContext browse
        map all lista
        browseDeepImpl browse node
    else browseDeepImpl browse node

@private
browseDeepImpl :: BrowseContext -> NodeContext -> <Proc> ()
browseDeepImpl browse node = do
    labeldecorator = syncRead $ \_ -> browseContextLabelDecorator browse node
    stubbi = decorateLabelStub labeldecorator
    labels = syncRead $ \_ -> browseContextLabel  browse node
    Map.iter(\k v -> (stubbi k v)) labels
    images = syncRead $ \_ -> browseContextImage browse node
    state = syncRead $ \_ -> browseContextCheckedState browse node
    imagedecorator = syncRead $ \_ -> browseContextImageDecorator browse node
    res = getConstant node BuiltinKeys.INPUT
    actioncontext = syncRead $ \_ -> createActionBrowseContext [PROJECT.ProjectActionContext]
    actions = syncRead $ \_ -> getActions actioncontext node [node]
    Map.iter (\k v -> do
        laabel = getIActionCateogryLabel k
        prioo = getIActionCategoryPriority k
        subm = isIActionCategorySubmenu k
        //print (laabel + " " + (show prioo) + " " + (show subm))
        iter printActionDetails (sort v)
    ) actions
    modifier = syncRead $ \_ -> browseContextModifier browse node "single"
    match modifier with
        Nothing -> ()
        Just modif -> do
            val = getValue modif
            valid = isValid modif val
            ()

@private
printActionDetails :: Action -> <Proc> ()
printActionDetails action = do
    teext = getActionText action
    iid = getActionId action
    //print ("-- " + teext + " (" + iid + ")")
    ()

@private
decorateLabelStub :: LabelDecorator -> String -> String -> <Proc> ()
decorateLabelStub decorator key value = do
    fontti = decorateFont decorator getDefaultFontDescriptor key 0
    fontti = decorateBackground decorator Nothing key 0
    fontti = decorateForeground decorator Nothing key 0
    laabeli = decorateLabel decorator value key 0
    ()