content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE ForeignFunctionInterface #-}
  {-# LANGUAGE JavaScriptFFI #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  {-
    Copyright 2020 The CodeWorld Authors. All Rights Reserved.
  
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.
    You may obtain a copy of the License at
  
        http://www.apache.org/licenses/LICENSE-2.0
  
    Unless required by applicable law or agreed to in writing, software
    distributed under the License is distributed on an "AS IS" BASIS,
    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    See the License for the specific language governing permissions and
    limitations under the License.
  -}
  
  module Blockly.Workspace
    ( Workspace (..),
      setWorkspace,
      workspaceToCode,
      isTopBlock,
      getById,
      loadXml,
      getTopBlocksLength,
      getBlockById,
      getTopBlocks,
      getTopBlocksTrue,
      isWarning,
      disableOrphans,
      warnOnInputs,
      mainWorkspace,
    )
  where
  
  import Blockly.Block (Block (..))
  import Blockly.General
  import Data.JSString (pack, unpack)
  import Data.JSString.Text
  import qualified Data.Text as T
  import GHCJS.Foreign
  import GHCJS.Marshal
  import GHCJS.Types
  import qualified JavaScript.Array as JA
  import Unsafe.Coerce
  
  newtype Workspace = Workspace JSVal
  
  instance IsJSVal Workspace
  
  instance ToJSVal Workspace where
    toJSVal (Workspace v) = return v
  
  instance FromJSVal Workspace where
    fromJSVal v = return $ Just $ Workspace v
  
  setWorkspace :: String -> String -> IO Workspace
  setWorkspace canvasId toolboxId = js_blocklyInject (pack canvasId) (pack toolboxId)
  
  workspaceToCode :: Workspace -> IO String
  workspaceToCode workspace = js_blocklyWorkspaceToCode workspace >>= return . unpack
  
  getById :: UUID -> Workspace
  getById (UUID uuidStr) = js_getById (pack uuidStr)
  
  getBlockById :: Workspace -> UUID -> Maybe Block
  getBlockById workspace (UUID uuidstr) =
    if isNull val
      then Nothing
      else Just $ unsafeCoerce val
    where
      val = js_getBlockById workspace (pack uuidstr)
  
  isTopBlock :: Workspace -> Block -> Bool
  isTopBlock = js_isTopBlock
  
  isWarning :: Workspace -> IO (Block, T.Text)
  isWarning ws = do
    vals <- js_isWarning ws
    let ls = JA.toList vals
    return (Block (ls !! 0), textFromJSString $ (unsafeCoerce (ls !! 1) :: JSString))
  
  getTopBlocksLength :: Workspace -> Int
  getTopBlocksLength = js_getTopBlocksLength
  
  getTopBlocks :: Workspace -> IO [Block]
  getTopBlocks ws = do
    vals :: JA.JSArray <- js_getTopBlocks ws
    let vs = JA.toList vals
    return $ map Block vs
  
  getTopBlocksTrue :: Workspace -> IO [Block]
  getTopBlocksTrue ws = do
    vals :: JA.JSArray <- js_getTopBlocks_ ws
    let vs = JA.toList vals
    return $ map Block vs
  
  mainWorkspace :: Workspace
  mainWorkspace = js_getMainWorkspace
  
  disableOrphans :: Workspace -> IO ()
  disableOrphans = js_addDisableOrphans
  
  warnOnInputs :: Workspace -> IO ()
  warnOnInputs = js_addWarnOnInputs
  
  loadXml :: Workspace -> JSString -> IO ()
  loadXml workspace dat = js_loadXml workspace dat
  
  --- FFI
  #ifdef ghcjs_HOST_OS
  -- TODO Maybe use a list of properties ?
  foreign import javascript unsafe "Blockly.inject($1, { toolbox: document.getElementById($2), css: false, disable: false, comments: false, zoom:{wheel:true, controls: true}})"
    js_blocklyInject :: JSString -> JSString -> IO Workspace
  
  foreign import javascript unsafe "Blockly.FunBlocks.workspaceToCode($1)"
    js_blocklyWorkspaceToCode :: Workspace -> IO JSString
  
  foreign import javascript unsafe "$1.isTopBlock($2)"
    js_isTopBlock :: Workspace -> Block -> Bool
  
  foreign import javascript unsafe "$1.isWarning()"
    js_isWarning :: Workspace -> IO JA.JSArray
  
  foreign import javascript unsafe "Blockly.Workspace.getById($1)"
    js_getById :: JSString -> Workspace
  
  foreign import javascript unsafe "$1.getBlockById($2)"
    js_getBlockById :: Workspace -> JSString -> JSVal
  
  foreign import javascript unsafe "$1.getTopBlocks(false).length"
    js_getTopBlocksLength :: Workspace -> Int
  
  foreign import javascript unsafe "$1.getTopBlocks(false)"
    js_getTopBlocks :: Workspace -> IO JA.JSArray
  
  foreign import javascript unsafe "$1.getTopBlocks(true)"
    js_getTopBlocks_ :: Workspace -> IO JA.JSArray
  
  foreign import javascript unsafe "Blockly.Xml.domToWorkspace(Blockly.Xml.textToDom($2), $1)"
    js_loadXml :: Workspace -> JSString -> IO ()
  
  foreign import javascript unsafe "$1.addChangeListener(Blockly.Events.disableOrphans)"
    js_addDisableOrphans :: Workspace -> IO ()
  
  foreign import javascript unsafe "$1.addChangeListener(Blockly.Events.warnOnDisconnectedInputs)"
    js_addWarnOnInputs :: Workspace -> IO ()
  
  foreign import javascript unsafe "Blockly.getMainWorkspace()"
    js_getMainWorkspace :: Workspace
  
  #else
  
  js_blocklyInject :: JSString -> JSString -> IO Workspace
  js_blocklyInject = error "GHCJS required"
  js_blocklyWorkspaceToCode :: Workspace -> IO JSString
  js_blocklyWorkspaceToCode = error "GHCJS required"
  
  js_isTopBlock :: Workspace -> Block -> Bool
  js_isTopBlock = error "GHCJS required"
  
  js_isWarning :: Workspace -> IO JA.JSArray
  js_isWarning = error "GHCJS required"
  
  js_getById :: JSString -> Workspace
  js_getById = error "GHCJS required"
  
  js_getBlockById :: Workspace -> JSString -> JSVal
  js_getBlockById = error "GHCJS required"
  
  js_getTopBlocksLength :: Workspace -> Int
  js_getTopBlocksLength = error "GHCJS required"
  
  js_getTopBlocks :: Workspace -> IO JA.JSArray
  js_getTopBlocks = error "GHCJS required"
  
  js_getTopBlocks_ :: Workspace -> IO JA.JSArray
  js_getTopBlocks_ = error "GHCJS required"
  
  js_loadXml :: Workspace -> JSString -> IO ()
  js_loadXml = error "GHCJS required"
  
  js_addDisableOrphans :: Workspace -> IO ()
  js_addDisableOrphans = error "GHCJS required"
  
  js_addWarnOnInputs :: Workspace -> IO ()
  js_addWarnOnInputs = error "GHCJS required"
  
  js_getMainWorkspace :: Workspace
  js_getMainWorkspace = error "GHCJS required"
  
  #endif
  