/
Types.purs
262 lines (218 loc) · 8.8 KB
/
Types.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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
module MainFrame.Types where
import Analytics (class IsEvent, defaultEvent, toEvent)
import Auth (AuthStatus)
import Blockly.Types (BlocklyState)
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens (Lens', (^.))
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Symbol (SProxy(..))
import Demos.Types as Demos
import Gist (Gist, GistId)
import Gists.Types (GistAction)
import Halogen (ClassName)
import Halogen as H
import Halogen.ActusBlockly as AB
import Halogen.Blockly as Blockly
import Halogen.Classes (activeClass)
import Halogen.Monaco (KeyBindings)
import Halogen.Monaco as Monaco
import HaskellEditor.Types as HE
import JavascriptEditor.Types (CompilationState)
import JavascriptEditor.Types as JS
import NewProject.Types as NewProject
import Prelude (class Eq, class Show, Unit, eq, show, (<<<), ($))
import Projects.Types as Projects
import Rename.Types as Rename
import Router (Route)
import SaveAs.Types as SaveAs
import Simulation.Types as Simulation
import Types (WebData)
import Wallet as Wallet
import Web.UIEvent.KeyboardEvent (KeyboardEvent)
data ModalView
= NewProject
| OpenProject
| OpenDemo
| RenameProject
| SaveProjectAs
| GithubLogin Action
derive instance genericModalView :: Generic ModalView _
instance showModalView :: Show ModalView where
show NewProject = "NewProject"
show OpenProject = "OpenProject"
show OpenDemo = "OpenDemo"
show RenameProject = "RenameProject"
show SaveProjectAs = "SaveProjectAs"
show (GithubLogin _) = "GithubLogin"
-- Before adding the intended action to GithubLogin, this instance was being
-- handled by the genericShow. Action does not have a show instance so genericShow
-- does not work. For the moment I've made a manual instance, but not sure why
-- ModalView requires show, or if we should make Action an instance of Show
-- show = genericShow
data Query a
= ChangeRoute Route a
data Action
= Init
| HandleKey H.SubscriptionId KeyboardEvent
| HaskellAction HE.Action
| SimulationAction Simulation.Action
| SendBlocklyToSimulator
| JavascriptAction JS.Action
| ShowBottomPanel Boolean
| ChangeView View
-- blockly
| HandleBlocklyMessage Blockly.Message
| HandleActusBlocklyMessage AB.Message
-- Wallet Actions
| HandleWalletMessage Wallet.Message
| ProjectsAction Projects.Action
| NewProjectAction NewProject.Action
| DemosAction Demos.Action
| RenameAction Rename.Action
| SaveAsAction SaveAs.Action
-- Gist support.
| CheckAuthStatus
| GistAction GistAction
| OpenModal ModalView
| CloseModal
| ChangeProjectName String
| OpenLoginPopup Action
-- | Here we decide which top-level queries to track as GA events, and
-- how to classify them.
instance actionIsEvent :: IsEvent Action where
toEvent Init = Just $ defaultEvent "Init"
toEvent (HandleKey _ _) = Just $ defaultEvent "HandleKey"
toEvent (HaskellAction action) = toEvent action
toEvent (SimulationAction action) = toEvent action
toEvent SendBlocklyToSimulator = Just $ defaultEvent "SendBlocklyToSimulator"
toEvent (JavascriptAction action) = toEvent action
toEvent (HandleWalletMessage action) = Just $ defaultEvent "HandleWalletMessage"
toEvent (ChangeView view) = Just $ (defaultEvent "View") { label = Just (show view) }
toEvent (HandleBlocklyMessage _) = Just $ (defaultEvent "HandleBlocklyMessage") { category = Just "Blockly" }
toEvent (HandleActusBlocklyMessage _) = Just $ (defaultEvent "HandleActusBlocklyMessage") { category = Just "ActusBlockly" }
toEvent (ShowBottomPanel _) = Just $ defaultEvent "ShowBottomPanel"
toEvent (ProjectsAction action) = toEvent action
toEvent (NewProjectAction action) = toEvent action
toEvent (DemosAction action) = toEvent action
toEvent (RenameAction action) = toEvent action
toEvent (SaveAsAction action) = toEvent action
toEvent CheckAuthStatus = Just $ defaultEvent "CheckAuthStatus"
toEvent (GistAction _) = Just $ defaultEvent "GistAction"
toEvent (OpenModal view) = Just $ (defaultEvent (show view)) { category = Just "OpenModal" }
toEvent CloseModal = Just $ defaultEvent "CloseModal"
toEvent (ChangeProjectName _) = Just $ defaultEvent "ChangeProjectName"
toEvent (OpenLoginPopup _) = Just $ defaultEvent "OpenLoginPopup"
data View
= HomePage
| HaskellEditor
| JSEditor
| Simulation
| BlocklyEditor
| ActusBlocklyEditor
| WalletEmulator
derive instance eqView :: Eq View
derive instance genericView :: Generic View _
instance showView :: Show View where
show = genericShow
type ChildSlots
= ( haskellEditorSlot :: H.Slot Monaco.Query Monaco.Message Unit
, jsEditorSlot :: H.Slot Monaco.Query Monaco.Message Unit
, blocklySlot :: H.Slot Blockly.Query Blockly.Message Unit
, actusBlocklySlot :: H.Slot AB.Query AB.Message Unit
, simulationSlot :: H.Slot Simulation.Query Blockly.Message Unit
, marloweEditorSlot :: H.Slot Monaco.Query Monaco.Message Unit
, walletSlot :: H.Slot Wallet.Query Wallet.Message Unit
)
_haskellEditorSlot :: SProxy "haskellEditorSlot"
_haskellEditorSlot = SProxy
_jsEditorSlot :: SProxy "jsEditorSlot"
_jsEditorSlot = SProxy
_blocklySlot :: SProxy "blocklySlot"
_blocklySlot = SProxy
_actusBlocklySlot :: SProxy "actusBlocklySlot"
_actusBlocklySlot = SProxy
_simulationSlot :: SProxy "simulationSlot"
_simulationSlot = SProxy
_marloweEditorSlot :: SProxy "marloweEditorSlot"
_marloweEditorSlot = SProxy
_walletSlot :: SProxy "walletSlot"
_walletSlot = SProxy
-----------------------------------------------------------
newtype State
= State
{ view :: View
, jsCompilationResult :: CompilationState
, blocklyState :: Maybe BlocklyState
, actusBlocklyState :: Maybe BlocklyState
, jsEditorKeybindings :: KeyBindings
, activeJSDemo :: String
, showBottomPanel :: Boolean
, haskellState :: HE.State
, javascriptState :: JS.State
, simulationState :: Simulation.State
, projects :: Projects.State
, newProject :: NewProject.State
, rename :: Rename.State
, saveAs :: SaveAs.State
, authStatus :: WebData AuthStatus
, gistId :: Maybe GistId
, createGistResult :: WebData Gist
, loadGistResult :: Either String (WebData Gist)
, projectName :: String
, showModal :: Maybe ModalView
}
derive instance newtypeState :: Newtype State _
_view :: Lens' State View
_view = _Newtype <<< prop (SProxy :: SProxy "view")
_jsCompilationResult :: Lens' State CompilationState
_jsCompilationResult = _Newtype <<< prop (SProxy :: SProxy "jsCompilationResult")
_blocklyState :: Lens' State (Maybe BlocklyState)
_blocklyState = _Newtype <<< prop (SProxy :: SProxy "blocklyState")
_actusBlocklyState :: Lens' State (Maybe BlocklyState)
_actusBlocklyState = _Newtype <<< prop (SProxy :: SProxy "actusBlocklyState")
_jsEditorKeybindings :: Lens' State KeyBindings
_jsEditorKeybindings = _Newtype <<< prop (SProxy :: SProxy "jsEditorKeybindings")
_activeJSDemo :: Lens' State String
_activeJSDemo = _Newtype <<< prop (SProxy :: SProxy "activeJSDemo")
_showBottomPanel :: Lens' State Boolean
_showBottomPanel = _Newtype <<< prop (SProxy :: SProxy "showBottomPanel")
_haskellState :: Lens' State HE.State
_haskellState = _Newtype <<< prop (SProxy :: SProxy "haskellState")
_javascriptState :: Lens' State JS.State
_javascriptState = _Newtype <<< prop (SProxy :: SProxy "javascriptState")
_simulationState :: Lens' State Simulation.State
_simulationState = _Newtype <<< prop (SProxy :: SProxy "simulationState")
_projects :: Lens' State Projects.State
_projects = _Newtype <<< prop (SProxy :: SProxy "projects")
_newProject :: Lens' State NewProject.State
_newProject = _Newtype <<< prop (SProxy :: SProxy "newProject")
_rename :: Lens' State Rename.State
_rename = _Newtype <<< prop (SProxy :: SProxy "rename")
_saveAs :: Lens' State SaveAs.State
_saveAs = _Newtype <<< prop (SProxy :: SProxy "saveAs")
_authStatus :: Lens' State (WebData AuthStatus)
_authStatus = _Newtype <<< prop (SProxy :: SProxy "authStatus")
_gistId :: Lens' State (Maybe GistId)
_gistId = _Newtype <<< prop (SProxy :: SProxy "gistId")
_createGistResult :: Lens' State (WebData Gist)
_createGistResult = _Newtype <<< prop (SProxy :: SProxy "createGistResult")
_loadGistResult :: Lens' State (Either String (WebData Gist))
_loadGistResult = _Newtype <<< prop (SProxy :: SProxy "loadGistResult")
_projectName :: Lens' State String
_projectName = _Newtype <<< prop (SProxy :: SProxy "projectName")
_showModal :: Lens' State (Maybe ModalView)
_showModal = _Newtype <<< prop (SProxy :: SProxy "showModal")
-- editable
_timestamp ::
forall s a.
Lens' { timestamp :: a | s } a
_timestamp = prop (SProxy :: SProxy "timestamp")
_value :: forall s a. Lens' { value :: a | s } a
_value = prop (SProxy :: SProxy "value")
isActiveTab :: State -> View -> Array ClassName
isActiveTab state activeView = state ^. _view <<< (activeClass (eq activeView))