{-# LANGUAGE CPP, MultiParamTypeClasses #-}

module MVD.DebuggerJS where 

#ifdef __GHCJS__
import GHC.JS.Foreign.Callback
import GHC.JS.Prim
import Data.IORef

foreign import javascript unsafe "consoleLog"
  consoleLog :: JSVal -> IO ()

foreign import javascript "((a) => { globalTakeUserAction = a })"
  setA ::Callback (JSVal -> IO JSVal) -> IO JSVal

foreign import javascript "((f) => { globalF = f })"
  setF :: Callback (JSVal -> IO ()) -> IO ()

#endif


data ProgramState c a = ProgramState {guiDebugConfig :: c , guiStateActions :: [a]}

class DebugGUI c a where
    -- here Integer is an identifier for the debug action corresponding to the subject language action a
    config_to_html :: c -> [(Integer, a)] -> IO () 
    -- draw_choices :: [(Integer, c)] -> a -> IO()
    -- the type a must be included in the following signature, I wonder why.
    -- draw_history :: [c] -> a -> IO ()

#ifdef __GHCJS__
debuggerGUI ::  (Show a, Show c, Show m, DebugGUI c a) => STR c a m  -> Finder c a m -> IO () 
debuggerGUI o fnd = do 
    let doo = reducedMultiverseDebuggerBridge o fnd 

    let c = (head . initial $ doo)
    let a = actions doo c
    let indexed_actions = zip a [0..]


    let subject_language_actions = [ (i, a) | (Step a, i) <- indexed_actions ]
    let choices = [(i, config) | (Choice config, i) <- indexed_actions]

    
    case current c of 
        Nothing -> do
            draw_choices choices
            -- consoleLog $ toJSString( "error " ++  (show $  options c) ++ "actions : " ++ show subject_language_actions)
            -- return () -- TODO probably dont want this to happen
        Just c -> draw_current c subject_language_actions

    r <- newIORef $ ProgramState {
        guiDebugConfig = c
        , guiStateActions = a}

    consoleLog $ toJSString $ "here" 

    let m_log ::  IO (Callback (JSVal -> IO JSVal)) =  syncCallback1' (handler o doo fnd r ) 
    log <- m_log
    consoleLog $ toJSString $ "here1" 

    let mi_a :: IO Int = fromJSInt <$> setA log
    i_a <- mi_a
    print i_a

handler ::(Show a, Show c, DebugGUI c a) => STR c a m-> STR (DebugConfig c) (DebugAction a c) m 
    -> Finder c a m e r alpha -> IORef (ProgramState (DebugConfig c) (DebugAction a c)) -> JSVal -> IO JSVal
handler o doo fnd state_ref v = do
    consoleLog $ toJSString $ "here handler" 

    state <- readIORef state_ref
    let i = fromJSInt v
    -- consoleLog $ toJSString $  "list of possible actions was: " ++ (show $ actions state)
    -- consoleLog $ toJSString $ "choice: " ++ show i
    
    let tempc = rmdExecute o fnd (Right ((guiStateActions state) !! i)) (guiDebugConfig state)

    let newc = if length tempc > 0 then head tempc else head tempc 

    let new_actions = actions doo newc


    modifyIORef state_ref $ const $ ProgramState newc new_actions
    
    let subject_language_actions = [ (i, a) | (Step a, i) <- zip new_actions [0..] ]
    case current newc of 
        Nothing -> return () -- TODO probably dont want this to happen
        Just c ->     draw_current c subject_language_actions

    return v
#endif