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
}
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)
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)
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
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
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)
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
-> AceDynConfig
-> R.Event t AceDynConfig
-> Text
-> Text
-> R.Event t Text
-> 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
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
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)