Add aceWidgetStatic

reflex-dom-ace.cabal

@@ -32,17 +32,18 @@ library
 
   default-language: Haskell2010
 
-executable reflex-dom-ace-exe
-  buildable:           False
-  hs-source-dirs:      app
-  main-is:             Main.hs
-  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , directory
-                     , jsaddle
-                     , jsaddle-warp
-                     , reflex-dom
-                     , reflex-dom-core
-                     , reflex-dom-ace
-                     , text
-                     , wai-app-static
+-- Commented out for now to avoid build dependency issues
+-- executable reflex-dom-ace-exe
+--   buildable:           False
+--   hs-source-dirs:      app
+--   main-is:             Main.hs
+--   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
+--   build-depends:       base
+--                      , directory
+--                      , jsaddle
+--                      , jsaddle-warp
+--                      , reflex-dom
+--                      , reflex-dom-core
+--                      , reflex-dom-ace
+--                      , text
+--                      , wai-app-static

src/Reflex/Dom/ACE.hs

@@ -137,6 +137,7 @@ data AceConfig = AceConfig
     , _aceConfigMode            :: Maybe Text
     , _aceConfigWordWrap        :: Bool
     , _aceConfigShowPrintMargin :: Bool
+    , _aceConfigReadOnly        :: Bool
     }
 
 
@@ -146,7 +147,7 @@ data AceDynConfig = AceDynConfig
 
 
 instance Default AceConfig where
-    def = AceConfig def def def False False
+    def = AceConfig def def def False False False
 
 
 newtype AceInstance = AceInstance { unAceInstance :: JSVal }
@@ -216,6 +217,8 @@ startACE elmt ac = liftJSM $ do
   unless (T.null mode) $ do
     session <- editSession ^. js "session"
     void $ session ^. js1 "setMode" mode
+  -- Set readOnly
+  void $ editSession ^. js1 "setReadOnly" (_aceConfigReadOnly ac)
   let aceInst  = AceInstance editSession
   setUseWrapMode (_aceConfigWordWrap ac) aceInst
   setShowPrintMargin (_aceConfigShowPrintMargin ac) aceInst
@@ -243,6 +246,12 @@ setModeACE mode (AceInstance ace) = liftJSM $ do
   void $ session ^. js1 "setMode" mode
 
 
+------------------------------------------------------------------------------
+setReadOnlyACE :: MonadJSM m => Bool -> AceInstance -> m ()
+setReadOnlyACE readOnly (AceInstance ace) =
+  liftJSM $ void $ ace ^. js1 "setReadOnly" readOnly
+
+
 ------------------------------------------------------------------------------
 setUseWrapMode :: MonadJSM m => Bool -> AceInstance -> m ()
 setUseWrapMode shouldWrap (AceInstance ace) = liftJSM $ do
@@ -332,6 +341,34 @@ aceWidget ac adc adcUps initContents = do
       (_aceDynConfigTheme c)
 
 
+------------------------------------------------------------------------------
+-- | This function is the same a aceWidget except it uses elAttr' instead of
+-- elDynAttr' which for some unexplained reason solves editor rendering
+-- problems in some situations.
+--
+-- We're adding this as a separate function to avoid potentially breaking
+-- users that may have been depending on the old behavior.  This function may
+-- replace aceWidget in the future and go away.
+aceWidgetStatic
+    :: MonadWidget t m
+    => AceConfig -> AceDynConfig -> Text -> m (ACE t)
+aceWidgetStatic ac adc initContents = do
+    aceDiv <- fmap fst $ elAttr' (T.pack "div") (addThemeAttr adc) $ text initContents
+    aceInstance <- startACE (_element_raw aceDiv) ac
+    onChange <- setupValueListener aceInstance
+    updatesDyn <- holdDyn initContents onChange
+
+    let ace = ACE (constDyn $ pure aceInstance) updatesDyn
+    setThemeACE (_aceDynConfigTheme adc) aceInstance
+    return ace
+  where
+    static = _aceConfigElemAttrs ac
+    themeAttr t = T.pack $ " ace-" <> show t
+    addThemeAttr c = maybe static
+      (\t -> M.insertWith (<>) (T.pack "class") (themeAttr t) static)
+      (_aceDynConfigTheme c)
+
+
 ------------------------------------------------------------------------------
 -- | Convenient helper function for running functions that need an AceInstance.
 withAceInstance