-
Notifications
You must be signed in to change notification settings - Fork 461
/
Monaco.purs
138 lines (102 loc) · 4.7 KB
/
Monaco.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
module Monaco where
import Prelude
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.String.Regex (Regex)
import Data.Tuple (Tuple)
import Effect (Effect)
import Effect.Uncurried (EffectFn2, EffectFn3, runEffectFn2, runEffectFn3)
import Foreign (unsafeToForeign)
import Foreign.Generic (class Encode, Foreign, SumEncoding(..), defaultOptions, encode, genericEncode)
import Foreign.Object (Object)
import Foreign.Object as Object
import Web.HTML (HTMLElement)
class Default a where
default :: a
newtype LanguageExtensionPoint
= LanguageExtensionPoint { id :: String }
derive instance newtypeLanguageExtensionPoint :: Newtype LanguageExtensionPoint _
derive instance genericLanguageExtensionPoint :: Generic LanguageExtensionPoint _
derive newtype instance encodeLanguageExtensionPoint :: Encode LanguageExtensionPoint
newtype MonarchLanguageBracket
= MonarchLanguageBracket { close :: String, open :: String, token :: String }
derive instance newtypeMonarchLanguageBracket :: Newtype MonarchLanguageBracket _
derive instance genericMonarchLanguageBracket :: Generic MonarchLanguageBracket _
derive newtype instance encodeMonarchLanguageBracket :: Encode MonarchLanguageBracket
data Action
= Action { token :: String, next :: Maybe String, log :: Maybe String }
| Cases { cases :: (Object String), log :: Maybe String }
derive instance genericAction :: Generic Action _
instance encodeAction :: Encode Action where
encode a =
let
sumEncoding =
TaggedObject
{ tagFieldName: "tag"
, contentsFieldName: "contents"
, constructorTagTransform: identity
, unwrapRecords: true
}
in
genericEncode (defaultOptions { sumEncoding = sumEncoding }) a
newtype LanguageRule
= LanguageRule { regex :: Regex, action :: Action }
derive instance newtypeLanguageRule :: Newtype LanguageRule _
derive instance genericLanguageRule :: Generic LanguageRule _
instance encodeLanguageRule :: Encode LanguageRule where
encode (LanguageRule r) = encode { regex: unsafeToForeign r.regex, action: r.action }
simpleRule :: Regex -> String -> LanguageRule
simpleRule regex token = LanguageRule { regex, action: Action { token, next: Nothing, log: Nothing } }
simpleRuleWithLog :: Regex -> String -> String -> LanguageRule
simpleRuleWithLog regex token msg = LanguageRule { regex, action: Action { token, next: Nothing, log: Just msg } }
simpleRuleWithAction :: Regex -> String -> String -> LanguageRule
simpleRuleWithAction regex token next = LanguageRule { regex, action: Action { token, next: Just next, log: Nothing } }
simpleRuleCases :: Regex -> Array (Tuple String String) -> LanguageRule
simpleRuleCases regex cases = LanguageRule { regex, action: Cases { log: Nothing, cases: (Object.fromFoldable cases) } }
simpleRuleCasesWithLog :: Regex -> String -> Array (Tuple String String) -> LanguageRule
simpleRuleCasesWithLog regex msg cases = LanguageRule { regex, action: Cases { log: Just msg, cases: (Object.fromFoldable cases) } }
newtype MonarchLanguage
= MonarchLanguage
{ brackets :: Maybe (Array MonarchLanguageBracket)
, defaultToken :: Maybe String
, ignoreCase :: Maybe Boolean
, start :: Maybe String
, tokenPostfix :: Maybe String
, tokenizer :: Object (Array LanguageRule)
-- FIXME: I need to have any record key I want here, to be extensible
, keywords :: Maybe (Array String)
}
derive instance newtypeMonarchLanguage :: Newtype MonarchLanguage _
derive instance genericMonarchLanguage :: Generic MonarchLanguage _
derive newtype instance encodeMonarchLanguage :: Encode MonarchLanguage
instance defaultMonarchLanguage :: Default MonarchLanguage where
default =
MonarchLanguage
{ brackets: Nothing
, defaultToken: Nothing
, ignoreCase: Nothing
, start: Nothing
, tokenPostfix: Nothing
, tokenizer: mempty
, keywords: Nothing
}
foreign import data Monaco :: Type
foreign import getMonaco :: Effect Monaco
foreign import create_ :: EffectFn3 Monaco HTMLElement String Unit
foreign import registerLanguage_ :: EffectFn2 Monaco Foreign Unit
foreign import setMonarchTokensProvider_ :: EffectFn3 Monaco String Foreign Unit
create :: Monaco -> HTMLElement -> String -> Effect Unit
create = runEffectFn3 create_
registerLanguage :: Monaco -> LanguageExtensionPoint -> Effect Unit
registerLanguage monaco language =
let
languageF = encode language
in
runEffectFn2 registerLanguage_ monaco languageF
setMonarchTokensProvider :: Monaco -> String -> MonarchLanguage -> Effect Unit
setMonarchTokensProvider monaco languageId languageDef =
let
languageDefF = encode languageDef
in
runEffectFn3 setMonarchTokensProvider_ monaco languageId languageDefF