{-|

Basic support for using the Ace editor with Reflex.

-}

module Reflex.Dom.Ace where

import Control.Lens ((^.))
import Control.Monad (unless, void, join)
import Data.Default (Default)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Control.Monad.Trans as Trans
import qualified Data.Bifunctor as Bi

import qualified Language.Javascript.JSaddle as JS
import Language.Javascript.JSaddle.Object ((<#))
import qualified Reflex.Dom.Core as R


data AceTheme
  = AceTheme_Chrome
  | AceTheme_Clouds
  | AceTheme_CrimsonEditor
  | AceTheme_Dawn
  | AceTheme_Dreamweaver
  | AceTheme_Eclipse
  | AceTheme_Github
  | AceTheme_Iplastic
  | AceTheme_SolarizedLight
  | AceTheme_Textmate
  | AceTheme_Tomorrow
  | AceTheme_Xcode
  | AceTheme_Kuroir
  | AceTheme_Katzenmilch
  | AceTheme_Sqlserver
  | AceTheme_Ambiance
  | AceTheme_Chaos
  | AceTheme_CloudsMidnight
  | AceTheme_Cobalt
  | AceTheme_Gruvbox
  | AceTheme_IdleFingers
  | AceTheme_KrTheme
  | AceTheme_Merbivore
  | AceTheme_MerbivoreSoft
  | AceTheme_MonoIndustrial
  | AceTheme_Monokai
  | AceTheme_PastelOnDark
  | AceTheme_SolarizedDark
  | AceTheme_Terminal
  | AceTheme_TomorrowNight
  | AceTheme_TomorrowNightBlue
  | AceTheme_TomorrowNightBright
  | AceTheme_TomorrowNightEighties
  | AceTheme_Twilight
  | AceTheme_VibrantInk
  deriving (AceTheme -> AceTheme -> Bool
(AceTheme -> AceTheme -> Bool)
-> (AceTheme -> AceTheme -> Bool) -> Eq AceTheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AceTheme -> AceTheme -> Bool
$c/= :: AceTheme -> AceTheme -> Bool
== :: AceTheme -> AceTheme -> Bool
$c== :: AceTheme -> AceTheme -> Bool
Eq,Eq AceTheme
Eq AceTheme
-> (AceTheme -> AceTheme -> Ordering)
-> (AceTheme -> AceTheme -> Bool)
-> (AceTheme -> AceTheme -> Bool)
-> (AceTheme -> AceTheme -> Bool)
-> (AceTheme -> AceTheme -> Bool)
-> (AceTheme -> AceTheme -> AceTheme)
-> (AceTheme -> AceTheme -> AceTheme)
-> Ord AceTheme
AceTheme -> AceTheme -> Bool
AceTheme -> AceTheme -> Ordering
AceTheme -> AceTheme -> AceTheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AceTheme -> AceTheme -> AceTheme
$cmin :: AceTheme -> AceTheme -> AceTheme
max :: AceTheme -> AceTheme -> AceTheme
$cmax :: AceTheme -> AceTheme -> AceTheme
>= :: AceTheme -> AceTheme -> Bool
$c>= :: AceTheme -> AceTheme -> Bool
> :: AceTheme -> AceTheme -> Bool
$c> :: AceTheme -> AceTheme -> Bool
<= :: AceTheme -> AceTheme -> Bool
$c<= :: AceTheme -> AceTheme -> Bool
< :: AceTheme -> AceTheme -> Bool
$c< :: AceTheme -> AceTheme -> Bool
compare :: AceTheme -> AceTheme -> Ordering
$ccompare :: AceTheme -> AceTheme -> Ordering
$cp1Ord :: Eq AceTheme
Ord,Int -> AceTheme
AceTheme -> Int
AceTheme -> [AceTheme]
AceTheme -> AceTheme
AceTheme -> AceTheme -> [AceTheme]
AceTheme -> AceTheme -> AceTheme -> [AceTheme]
(AceTheme -> AceTheme)
-> (AceTheme -> AceTheme)
-> (Int -> AceTheme)
-> (AceTheme -> Int)
-> (AceTheme -> [AceTheme])
-> (AceTheme -> AceTheme -> [AceTheme])
-> (AceTheme -> AceTheme -> [AceTheme])
-> (AceTheme -> AceTheme -> AceTheme -> [AceTheme])
-> Enum AceTheme
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AceTheme -> AceTheme -> AceTheme -> [AceTheme]
$cenumFromThenTo :: AceTheme -> AceTheme -> AceTheme -> [AceTheme]
enumFromTo :: AceTheme -> AceTheme -> [AceTheme]
$cenumFromTo :: AceTheme -> AceTheme -> [AceTheme]
enumFromThen :: AceTheme -> AceTheme -> [AceTheme]
$cenumFromThen :: AceTheme -> AceTheme -> [AceTheme]
enumFrom :: AceTheme -> [AceTheme]
$cenumFrom :: AceTheme -> [AceTheme]
fromEnum :: AceTheme -> Int
$cfromEnum :: AceTheme -> Int
toEnum :: Int -> AceTheme
$ctoEnum :: Int -> AceTheme
pred :: AceTheme -> AceTheme
$cpred :: AceTheme -> AceTheme
succ :: AceTheme -> AceTheme
$csucc :: AceTheme -> AceTheme
Enum,AceTheme
AceTheme -> AceTheme -> Bounded AceTheme
forall a. a -> a -> Bounded a
maxBound :: AceTheme
$cmaxBound :: AceTheme
minBound :: AceTheme
$cminBound :: AceTheme
Bounded)

instance Show AceTheme where
    show :: AceTheme -> String
show AceTheme
AceTheme_Ambiance              = String
"ambiance"
    show AceTheme
AceTheme_Chaos                 = String
"chaos"
    show AceTheme
AceTheme_Chrome                = String
"chrome"
    show AceTheme
AceTheme_Clouds                = String
"clouds"
    show AceTheme
AceTheme_CloudsMidnight        = String
"clouds_midnight"
    show AceTheme
AceTheme_Cobalt                = String
"cobalt"
    show AceTheme
AceTheme_CrimsonEditor         = String
"crimson_editor"
    show AceTheme
AceTheme_Dawn                  = String
"dawn"
    show AceTheme
AceTheme_Dreamweaver           = String
"dreamweaver"
    show AceTheme
AceTheme_Eclipse               = String
"eclipse"
    show AceTheme
AceTheme_Github                = String
"github"
    show AceTheme
AceTheme_Gruvbox               = String
"gruvbox"
    show AceTheme
AceTheme_IdleFingers           = String
"idle_fingers"
    show AceTheme
AceTheme_Iplastic              = String
"iplastic"
    show AceTheme
AceTheme_Katzenmilch           = String
"katzenmilch"
    show AceTheme
AceTheme_KrTheme               = String
"kr_theme"
    show AceTheme
AceTheme_Kuroir                = String
"kuroir"
    show AceTheme
AceTheme_Merbivore             = String
"merbivore"
    show AceTheme
AceTheme_MerbivoreSoft         = String
"merbivore_soft"
    show AceTheme
AceTheme_MonoIndustrial        = String
"mono_industrial"
    show AceTheme
AceTheme_Monokai               = String
"monokai"
    show AceTheme
AceTheme_PastelOnDark          = String
"pastel_on_dark"
    show AceTheme
AceTheme_SolarizedDark         = String
"solarized_dark"
    show AceTheme
AceTheme_SolarizedLight        = String
"solarized_light"
    show AceTheme
AceTheme_Sqlserver             = String
"sqlserver"
    show AceTheme
AceTheme_Terminal              = String
"terminal"
    show AceTheme
AceTheme_Textmate              = String
"textmate"
    show AceTheme
AceTheme_Tomorrow              = String
"tomorrow"
    show AceTheme
AceTheme_TomorrowNight         = String
"tomorrow_night"
    show AceTheme
AceTheme_TomorrowNightBlue     = String
"tomorrow_night_blue"
    show AceTheme
AceTheme_TomorrowNightBright   = String
"tomorrow_night_bright"
    show AceTheme
AceTheme_TomorrowNightEighties = String
"tomorrow_night_eighties"
    show AceTheme
AceTheme_Twilight              = String
"twilight"
    show AceTheme
AceTheme_VibrantInk            = String
"vibrant_ink"
    show AceTheme
AceTheme_Xcode                 = String
"xcode"


data AceConfig = AceConfig
    { AceConfig -> Map Text Text
_aceConfigElemAttrs       :: Map Text Text
    , AceConfig -> Maybe Text
_aceConfigBasePath        :: Maybe Text
    , AceConfig -> Maybe Text
_aceConfigMode            :: Maybe Text
    , AceConfig -> Bool
_aceConfigWordWrap        :: Bool
    , AceConfig -> Bool
_aceConfigShowPrintMargin :: Bool
    }


data AceDynConfig = AceDynConfig
    { AceDynConfig -> Maybe AceTheme
_aceDynConfigTheme :: Maybe AceTheme
    }


instance Default AceConfig where
    def :: AceConfig
def = Map Text Text
-> Maybe Text -> Maybe Text -> Bool -> Bool -> AceConfig
AceConfig Map Text Text
forall a. Default a => a
R.def Maybe Text
forall a. Default a => a
R.def Maybe Text
forall a. Default a => a
R.def Bool
False Bool
False


newtype AceInstance = AceInstance { AceInstance -> JSVal
unAceInstance :: JS.JSVal }


data Ace t = Ace
    { Ace t -> Dynamic t (Maybe AceInstance)
aceRef   :: R.Dynamic t (Maybe AceInstance)
    , Ace t -> Dynamic t Text
aceValue :: R.Dynamic t Text
    }


------------------------------------------------------------------------------
-- The type of editor session line annotation.
data AnnotationType = AnnotationError
                    | AnnotationWarning
                    deriving (Int -> AnnotationType -> ShowS
[AnnotationType] -> ShowS
AnnotationType -> String
(Int -> AnnotationType -> ShowS)
-> (AnnotationType -> String)
-> ([AnnotationType] -> ShowS)
-> Show AnnotationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnotationType] -> ShowS
$cshowList :: [AnnotationType] -> ShowS
show :: AnnotationType -> String
$cshow :: AnnotationType -> String
showsPrec :: Int -> AnnotationType -> ShowS
$cshowsPrec :: Int -> AnnotationType -> ShowS
Show, ReadPrec [AnnotationType]
ReadPrec AnnotationType
Int -> ReadS AnnotationType
ReadS [AnnotationType]
(Int -> ReadS AnnotationType)
-> ReadS [AnnotationType]
-> ReadPrec AnnotationType
-> ReadPrec [AnnotationType]
-> Read AnnotationType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AnnotationType]
$creadListPrec :: ReadPrec [AnnotationType]
readPrec :: ReadPrec AnnotationType
$creadPrec :: ReadPrec AnnotationType
readList :: ReadS [AnnotationType]
$creadList :: ReadS [AnnotationType]
readsPrec :: Int -> ReadS AnnotationType
$creadsPrec :: Int -> ReadS AnnotationType
Read)

------------------------------------------------------------------------------
instance JS.ToJSVal AnnotationType where
  toJSVal :: AnnotationType -> JSM JSVal
toJSVal AnnotationType
AnnotationError   = Text -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
JS.toJSVal (Text
"error":: Text)
  toJSVal AnnotationType
AnnotationWarning = Text -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
JS.toJSVal (Text
"warning" :: Text)


------------------------------------------------------------------------------
-- A line annotation for marking a specific line within the editor session as
-- an error or a warning.
data Annotation = Annotation { Annotation -> Int
annotationRow    :: Int
                             , Annotation -> Int
annotationColumn :: Int
                             , Annotation -> Text
annotationText   :: Text
                             , Annotation -> AnnotationType
annotationType   :: AnnotationType
                             } deriving (Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show, ReadPrec [Annotation]
ReadPrec Annotation
Int -> ReadS Annotation
ReadS [Annotation]
(Int -> ReadS Annotation)
-> ReadS [Annotation]
-> ReadPrec Annotation
-> ReadPrec [Annotation]
-> Read Annotation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Annotation]
$creadListPrec :: ReadPrec [Annotation]
readPrec :: ReadPrec Annotation
$creadPrec :: ReadPrec Annotation
readList :: ReadS [Annotation]
$creadList :: ReadS [Annotation]
readsPrec :: Int -> ReadS Annotation
$creadsPrec :: Int -> ReadS Annotation
Read)


------------------------------------------------------------------------------
instance JS.MakeObject Annotation where
  makeObject :: Annotation -> JSM Object
makeObject (Annotation Int
row Int
col Text
txt AnnotationType
typ) = do
    Object
o <- JSM Object
JS.create
    (Object
o Object -> Text -> Int -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (Text
"row" :: Text)   ) Int
row
    (Object
o Object -> Text -> Int -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (Text
"column" :: Text)) Int
col
    (Object
o Object -> Text -> Text -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (Text
"text" :: Text)  ) Text
txt
    (Object
o Object -> Text -> AnnotationType -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (Text
"type" :: Text)  ) AnnotationType
typ
    Object -> JSM Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
o


instance JS.ToJSVal Annotation where
  toJSVal :: Annotation -> JSM JSVal
toJSVal = (Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
JS.toJSVal (Object -> JSM JSVal) -> JSM Object -> JSM JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (JSM Object -> JSM JSVal)
-> (Annotation -> JSM Object) -> Annotation -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> JSM Object
forall this. MakeObject this => this -> JSM Object
JS.makeObject


------------------------------------------------------------------------------
startAce :: JS.MonadJSM m => Text -> AceConfig -> m AceInstance
startAce :: Text -> AceConfig -> m AceInstance
startAce Text
containerId AceConfig
ac = JSM AceInstance -> m AceInstance
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM AceInstance -> m AceInstance)
-> JSM AceInstance -> m AceInstance
forall a b. (a -> b) -> a -> b
$ do
  JSVal
aceVal <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
JS.jsg (Text
"ace" :: Text)
  let
    (Text
basePath, Text
mode) = (((AceConfig -> Maybe Text) -> Text)
 -> ((AceConfig -> Maybe Text) -> Text)
 -> (AceConfig -> Maybe Text, AceConfig -> Maybe Text)
 -> (Text, Text))
-> ((AceConfig -> Maybe Text) -> Text)
-> (AceConfig -> Maybe Text, AceConfig -> Maybe Text)
-> (Text, Text)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((AceConfig -> Maybe Text) -> Text)
-> ((AceConfig -> Maybe Text) -> Text)
-> (AceConfig -> Maybe Text, AceConfig -> Maybe Text)
-> (Text, Text)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
Bi.bimap (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
T.pack String
"") (Maybe Text -> Text)
-> ((AceConfig -> Maybe Text) -> Maybe Text)
-> (AceConfig -> Maybe Text)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AceConfig -> Maybe Text) -> AceConfig -> Maybe Text
forall a b. (a -> b) -> a -> b
$ AceConfig
ac))
      (AceConfig -> Maybe Text
_aceConfigBasePath, AceConfig -> Maybe Text
_aceConfigMode)
  -- Set the base path if given
  Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
basePath) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
    JSVal
config <- JSVal
aceVal JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
JS.js (Text
"config" :: Text)
    JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
config JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> Text -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
JS.js2 (Text
"set" :: Text) (Text
"basePath" :: Text) Text
basePath
  -- Start and return an editing session
  JSVal
editor <- JSVal
aceVal JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
JS.js1 (Text
"edit" :: Text) Text
containerId
  let aceInst :: AceInstance
aceInst = JSVal -> AceInstance
AceInstance JSVal
editor
  -- Set the mode if given
  Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
mode) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> AceInstance -> JSM ()
forall (m :: * -> *). MonadJSM m => Text -> AceInstance -> m ()
setModeAce Text
mode AceInstance
aceInst
  Bool -> AceInstance -> JSM ()
forall (m :: * -> *). MonadJSM m => Bool -> AceInstance -> m ()
setUseWrapMode (AceConfig -> Bool
_aceConfigWordWrap AceConfig
ac) AceInstance
aceInst
  Bool -> AceInstance -> JSM ()
forall (m :: * -> *). MonadJSM m => Bool -> AceInstance -> m ()
setShowPrintMargin (AceConfig -> Bool
_aceConfigShowPrintMargin AceConfig
ac) AceInstance
aceInst
  AceInstance -> JSM AceInstance
forall (m :: * -> *) a. Monad m => a -> m a
return AceInstance
aceInst


------------------------------------------------------------------------------
moveCursorToPosition :: JS.MonadJSM m => (Int, Int) -> AceInstance -> m ()
moveCursorToPosition :: (Int, Int) -> AceInstance -> m ()
moveCursorToPosition (Int
r, Int
c) (AceInstance JSVal
ace) =
  JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Int -> Int -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
JS.js2 (Text
"gotoLine" :: Text) Int
r Int
c


------------------------------------------------------------------------------
setThemeAce :: JS.MonadJSM m => Maybe AceTheme -> AceInstance -> m ()
setThemeAce :: Maybe AceTheme -> AceInstance -> m ()
setThemeAce Maybe AceTheme
Nothing      AceInstance
_                 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setThemeAce (Just AceTheme
theme) (AceInstance JSVal
ace) =
  JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> String -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
JS.js1 (Text
"setTheme" :: Text) String
themeStr
  where themeStr :: String
themeStr = String
"ace/theme/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> AceTheme -> String
forall a. Show a => a -> String
show AceTheme
theme


------------------------------------------------------------------------------
setModeAce :: JS.MonadJSM m => Text -> AceInstance -> m ()
setModeAce :: Text -> AceInstance -> m ()
setModeAce Text
mode (AceInstance JSVal
ace) = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
session <- JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
JS.js (Text
"session" :: Text)
  JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
session JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
JS.js1 (Text
"setMode" :: Text) Text
modeStr
  where modeStr :: Text
modeStr = Text
"ace/mode/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mode


------------------------------------------------------------------------------
setUseWrapMode :: JS.MonadJSM m => Bool -> AceInstance -> m ()
setUseWrapMode :: Bool -> AceInstance -> m ()
setUseWrapMode Bool
shouldWrap (AceInstance JSVal
ace) = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
session <- JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSF
forall name. ToJSString name => name -> JSF
JS.js0 (Text
"getSession" :: Text)
  JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
session JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Bool -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
JS.js1 (Text
"setUseWrapMode" :: Text) Bool
shouldWrap


------------------------------------------------------------------------------
setShowPrintMargin :: JS.MonadJSM m => Bool -> AceInstance -> m ()
setShowPrintMargin :: Bool -> AceInstance -> m ()
setShowPrintMargin Bool
shouldShow (AceInstance JSVal
ace) =
  JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> Bool -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
JS.js2 (Text
"setOption" :: Text) (Text
"showPrintMargin" :: Text) Bool
shouldShow


------------------------------------------------------------------------------
setUseWorker :: JS.MonadJSM m => Bool -> AceInstance -> m ()
setUseWorker :: Bool -> AceInstance -> m ()
setUseWorker Bool
shouldUse (AceInstance JSVal
ace) =
  JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> Bool -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
JS.js2 (Text
"setOption" :: Text) (Text
"useWorker" :: Text) Bool
shouldUse


------------------------------------------------------------------------------
setAnnotations :: JS.MonadJSM m => [Annotation] -> AceInstance -> m ()
setAnnotations :: [Annotation] -> AceInstance -> m ()
setAnnotations [Annotation]
as (AceInstance JSVal
ace) = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
session <- JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSF
forall name. ToJSString name => name -> JSF
JS.js0 (Text
"getSession" :: Text)
  JSVal
annotations <- [Annotation] -> JSM JSVal
forall a. ToJSVal a => [a] -> JSM JSVal
JS.toJSValListOf [Annotation]
as
  JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
session JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSVal -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
JS.js1 (Text
"setAnnotations" :: Text) JSVal
annotations


------------------------------------------------------------------------------
setConfigAce :: JS.MonadJSM m => Text -> Text -> AceInstance -> m ()
setConfigAce :: Text -> Text -> AceInstance -> m ()
setConfigAce Text
t1 Text
t2 (AceInstance JSVal
ace) = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
cfg <- JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
JS.js (Text
"config" :: Text)
  JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
cfg JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> Text -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
JS.js2 (Text
"set" :: Text) Text
t1 Text
t2


------------------------------------------------------------------------------
getValueAce :: JS.MonadJSM m => AceInstance -> m Text
getValueAce :: AceInstance -> m Text
getValueAce (AceInstance JSVal
ace) =
  JSM Text -> m Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM Text -> m Text) -> JSM Text -> m Text
forall a b. (a -> b) -> a -> b
$ JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSF
forall name. ToJSString name => name -> JSF
JS.js0 (Text
"getValue" :: Text) JSM JSVal -> (JSVal -> JSM Text) -> JSM Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Text
forall a. FromJSVal a => JSVal -> JSM a
JS.fromJSValUnchecked


------------------------------------------------------------------------------
setValueAce :: JS.MonadJSM m => Text -> AceInstance -> m ()
setValueAce :: Text -> AceInstance -> m ()
setValueAce Text
t (AceInstance JSVal
ace) =
  JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> Int -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
JS.js2 (Text
"setValue" :: Text) Text
t (-Int
1 :: Int)


------------------------------------------------------------------------------
setupValueListener
  :: ( JS.MonadJSM (R.Performable m)
     , R.DomBuilder t m
     , R.PostBuild t m
     , R.TriggerEvent t m
     , R.PerformEvent t m
     )
  => AceInstance
  -> m (R.Event t Text)
setupValueListener :: AceInstance -> m (Event t Text)
setupValueListener (AceInstance JSVal
ace) = do
  Event t ()
pb  <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
R.getPostBuild
  let act :: (Text -> IO ()) -> m ()
act Text -> IO ()
cb = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
JS.liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Function
jscb <- JSCallAsFunction -> JSM Function
JS.asyncFunction (JSCallAsFunction -> JSM Function)
-> JSCallAsFunction -> JSM Function
forall a b. (a -> b) -> a -> b
$ \JSVal
_ JSVal
_ [JSVal]
_ ->
          AceInstance -> JSM Text
forall (m :: * -> *). MonadJSM m => AceInstance -> m Text
getValueAce (JSVal -> AceInstance
AceInstance JSVal
ace) JSM Text -> (Text -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Trans.liftIO (IO () -> JSM ()) -> (Text -> IO ()) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
cb
        JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ace JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> Function -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
JS.js2 (Text
"on" :: Text) (Text
"change" :: Text) Function
jscb
  Event t ((Text -> IO ()) -> Performable m ()) -> m (Event t Text)
forall t (m :: * -> *) a.
(TriggerEvent t m, PerformEvent t m) =>
Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
R.performEventAsync ((Text -> IO ()) -> Performable m ()
forall (m :: * -> *). MonadJSM m => (Text -> IO ()) -> m ()
act ((Text -> IO ()) -> Performable m ())
-> Event t () -> Event t ((Text -> IO ()) -> Performable m ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ()
pb)


------------------------------------------------------------------------------
-- | Main entry point
--
-- IMPORTANT NOTE:
--
-- This currently does not work if your app is using reflex-dom's
-- mainWidgetWithHead or mainWidgetWithCss.
aceWidget
    :: ( R.DomBuilder t m
       , R.PostBuild t m
       , R.MonadHold t m
       , JS.MonadJSM m
       , R.TriggerEvent t m
       , R.PerformEvent t m
       , JS.MonadJSM (R.Performable m)
       )
    => AceConfig -- ^ Ace editor configurations
    -> AceDynConfig -- ^ Ace editor theme
    -> R.Event t AceDynConfig -- ^ Updatable Ace editor theme
    -> Text -- ^ ID of desired container element
    -> Text -- ^ Initial Ace editor contents
    -> R.Event t Text -- ^ Updatable Ace editor contents
    -> m (Ace t)
aceWidget :: AceConfig
-> AceDynConfig
-> Event t AceDynConfig
-> Text
-> Text
-> Event t Text
-> m (Ace t)
aceWidget AceConfig
ac AceDynConfig
adc Event t AceDynConfig
adcUps Text
containerId Text
initContents Event t Text
contentsUps = do
    AceInstance
aceInstance <- Text -> AceConfig -> m AceInstance
forall (m :: * -> *).
MonadJSM m =>
Text -> AceConfig -> m AceInstance
startAce Text
containerId AceConfig
ac
    Event t Text
onChange <- AceInstance -> m (Event t Text)
forall (m :: * -> *) t.
(MonadJSM (Performable m), DomBuilder t m, PostBuild t m,
 TriggerEvent t m, PerformEvent t m) =>
AceInstance -> m (Event t Text)
setupValueListener AceInstance
aceInstance
    Dynamic t Text
updatesDyn <- Text -> Event t Text -> m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
R.holdDyn Text
initContents Event t Text
onChange

    let ace :: Ace t
ace = Dynamic t (Maybe AceInstance) -> Dynamic t Text -> Ace t
forall t. Dynamic t (Maybe AceInstance) -> Dynamic t Text -> Ace t
Ace (Maybe AceInstance -> Dynamic t (Maybe AceInstance)
forall k (t :: k) a. Reflex t => a -> Dynamic t a
R.constDyn (Maybe AceInstance -> Dynamic t (Maybe AceInstance))
-> Maybe AceInstance -> Dynamic t (Maybe AceInstance)
forall a b. (a -> b) -> a -> b
$ AceInstance -> Maybe AceInstance
forall (f :: * -> *) a. Applicative f => a -> f a
pure AceInstance
aceInstance) Dynamic t Text
updatesDyn
    Maybe AceTheme -> AceInstance -> m ()
forall (m :: * -> *).
MonadJSM m =>
Maybe AceTheme -> AceInstance -> m ()
setThemeAce (AceDynConfig -> Maybe AceTheme
_aceDynConfigTheme AceDynConfig
adc) AceInstance
aceInstance
    m (Event t ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Event t ()) -> m ()) -> m (Event t ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Ace t
-> Event t (AceInstance -> Performable m ()) -> m (Event t ())
forall t (m :: * -> *).
PerformEvent t m =>
Ace t
-> Event t (AceInstance -> Performable m ()) -> m (Event t ())
withAceInstance Ace t
ace (Maybe AceTheme -> AceInstance -> Performable m ()
forall (m :: * -> *).
MonadJSM m =>
Maybe AceTheme -> AceInstance -> m ()
setThemeAce (Maybe AceTheme -> AceInstance -> Performable m ())
-> (AceDynConfig -> Maybe AceTheme)
-> AceDynConfig
-> AceInstance
-> Performable m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AceDynConfig -> Maybe AceTheme
_aceDynConfigTheme (AceDynConfig -> AceInstance -> Performable m ())
-> Event t AceDynConfig
-> Event t (AceInstance -> Performable m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t AceDynConfig
adcUps)
    Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
R.performEvent_ (Event t (Performable m ()) -> m ())
-> Event t (Performable m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Event t Text
-> (Text -> Performable m ()) -> Event t (Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
R.ffor Event t Text
contentsUps ((Text -> Performable m ()) -> Event t (Performable m ()))
-> (Text -> Performable m ()) -> Event t (Performable m ())
forall a b. (a -> b) -> a -> b
$ \Text
c -> Text -> AceInstance -> Performable m ()
forall (m :: * -> *). MonadJSM m => Text -> AceInstance -> m ()
setValueAce Text
c AceInstance
aceInstance
    Ace t -> m (Ace t)
forall (m :: * -> *) a. Monad m => a -> m a
return Ace t
ace


------------------------------------------------------------------------------
-- | Convenient helper function for running functions that need an AceInstance.
withAceInstance
    :: R.PerformEvent t m
    => Ace t
    -> R.Event t (AceInstance -> R.Performable m ())
    -> m (R.Event t ())
withAceInstance :: Ace t
-> Event t (AceInstance -> Performable m ()) -> m (Event t ())
withAceInstance Ace t
ace Event t (AceInstance -> Performable m ())
evt = Ace t
-> Event t (Maybe AceInstance -> Performable m ())
-> m (Event t ())
forall t (m :: * -> *) a.
PerformEvent t m =>
Ace t
-> Event t (Maybe AceInstance -> Performable m a) -> m (Event t a)
withAceInstance' Ace t
ace ((AceInstance -> Performable m ())
-> Maybe AceInstance -> Performable m ()
forall (m :: * -> *) t. Monad m => (t -> m ()) -> Maybe t -> m ()
f ((AceInstance -> Performable m ())
 -> Maybe AceInstance -> Performable m ())
-> Event t (AceInstance -> Performable m ())
-> Event t (Maybe AceInstance -> Performable m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (AceInstance -> Performable m ())
evt)
  where
    f :: (t -> m ()) -> Maybe t -> m ()
f t -> m ()
_ Maybe t
Nothing  = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    f t -> m ()
g (Just t
a) = t -> m ()
g t
a


------------------------------------------------------------------------------
-- | More powerful function for running functions that need an AceInstance.
withAceInstance'
    :: R.PerformEvent t m
    => Ace t
    -> R.Event t (Maybe AceInstance -> R.Performable m a)
    -> m (R.Event t a)
withAceInstance' :: Ace t
-> Event t (Maybe AceInstance -> Performable m a) -> m (Event t a)
withAceInstance' Ace t
ace =
  Event t (Performable m a) -> m (Event t a)
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
R.performEvent (Event t (Performable m a) -> m (Event t a))
-> (Event t (Maybe AceInstance -> Performable m a)
    -> Event t (Performable m a))
-> Event t (Maybe AceInstance -> Performable m a)
-> m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AceInstance
 -> (Maybe AceInstance -> Performable m a) -> Performable m a)
-> Dynamic t (Maybe AceInstance)
-> Event t (Maybe AceInstance -> Performable m a)
-> Event t (Performable m a)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
R.attachPromptlyDynWith (((Maybe AceInstance -> Performable m a)
 -> Maybe AceInstance -> Performable m a)
-> Maybe AceInstance
-> (Maybe AceInstance -> Performable m a)
-> Performable m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe AceInstance -> Performable m a)
-> Maybe AceInstance -> Performable m a
forall a b. (a -> b) -> a -> b
($)) (Ace t -> Dynamic t (Maybe AceInstance)
forall t. Ace t -> Dynamic t (Maybe AceInstance)
aceRef Ace t
ace)