ACE Widget

gistfile1.txt

newtype AceRef = AceRef { unAceRef :: JSVal }

data ACE t = ACE
    { aceRef :: AceRef
    , aceValue :: Dynamic t String
    }

------------------------------------------------------------------------------
startACE :: String -> IO AceRef
#ifdef ghcjs_HOST_OS
startACE = js_startACE . toJSString

foreign import javascript unsafe
  "ace['edit']($1);"
  js_startACE :: JSString -> IO AceRef
#else
startACE = error "startACE: can only be used with GHCJS"
#endif

------------------------------------------------------------------------------
moveCursorToPosition :: AceRef -> (Int, Int) -> IO ()
#ifdef ghcjs_HOST_OS
moveCursorToPosition a (r,c) = js_moveCursorToPosition a r c

foreign import javascript unsafe
  "$1['moveCursorToPosition']({row: $2, column: $3});"
  js_moveCursorToPosition :: AceRef -> Int -> Int -> IO ()
#else
moveursorToPosition = error "moveCursorToPosition: can only be used with GHCJS"
#endif

------------------------------------------------------------------------------
aceGetValue :: AceRef -> IO String
#ifdef ghcjs_HOST_OS
aceGetValue a = fromJSString <$> js_aceGetValue a

foreign import javascript unsafe
  "$1['getValue']();"
  js_aceGetValue :: AceRef -> IO JSString
#else
aceGetValue = error "aceGetValue: can only be used with GHCJS"
#endif

------------------------------------------------------------------------------
setupValueListener :: MonadWidget t m => AceRef -> m (Event t String)
#ifdef ghcjs_HOST_OS
setupValueListener ace = do
    postGui <- askPostGui
    runWithActions <- askRunWithActions
    e <- newEventWithTrigger $ \et -> do
          cb <- asyncCallback1 $ \_ -> liftIO $ do
              v <- aceGetValue ace
              postGui $ runWithActions [et :=> Identity v]
          js_setupValueListener ace cb
          return (return ())
          -- TODO Probably need some kind of unsubscribe mechanism
          --return $ liftIO unsubscribe
    return $! e

foreign import javascript unsafe
  "$1['on'](\"change\", $2);"
  js_setupValueListener :: AceRef -> Callback (JSVal -> IO ()) -> IO ()
#else
setupValueListener = error "setupValueListener: can only be used with GHCJS"
#endif


------------------------------------------------------------------------------
aceWidget :: MonadWidget t m => String -> m (Dynamic t String)
aceWidget initContents = do
    let elemId = "editor"
    elAttr "pre" ("id" =: elemId <> "class" =: "ui segment") $ text initContents

    --------------------------------------------------------------------------
    --ace <- liftIO $ startACE elemId
    --editorUpdates <- setupValueListener ace

    pb <- getPostBuild
    aceUpdates <- performEvent (liftIO (startACE "editor") <$ pb)
    res <- widgetHold (return never) $ setupValueListener <$> aceUpdates
    let editorUpdates = switchPromptlyDyn res
    --------------------------------------------------------------------------

    holdDyn initContents editorUpdates