Skip to content

Commit 2213161

Browse files
epostepost
committed
studio: Make studio component's render, eval, etc top-level for reusability. #367 
1 parent 37e5e28 commit 2213161

File tree

1 file changed

+102
-102
lines changed

1 file changed

+102
-102
lines changed

‎studio/src/View/Studio.purs‎

Lines changed: 102 additions & 102 deletions
Original file line numberDiff line numberDiff line change
@@ -46,106 +46,106 @@ ui =
4646
, eval: mkEval $ defaultEval { handleAction = handleAction, handleQuery = handleQuery }
4747
, render: render
4848
}
49-
where
50-
mkInitialState :: Input -> State
51-
mkInitialState input = input
52-
53-
handleQuery :: ∀ a. Query a -> H.HalogenM State Action ChildSlots Void m (Maybe a)
54-
handleQuery = case _ of
55-
LoadTransactionsThenView endpointUrl hash next -> do
56-
handleAction (LoadTransactions endpointUrl hash)
57-
58-
-- after the transaction and its history have been loaded, display it
59-
state <- H.get
60-
let txSumMaybe = AdjacencySpace.lookup hash state.hashSpace
61-
for_ txSumMaybe $ handleAction <<< SelectRoute <<< Route.fromTxSum endpointUrl hash
62-
63-
pure (Just next)
64-
65-
handleAction :: Action -> HalogenM State Action ChildSlots Void m Unit
66-
handleAction = case _ of
67-
ShowDiagramNodeContent route -> do
68-
handleAction (SelectRoute route)
69-
70-
SelectRoute route -> do
71-
-- H.liftEffect $ log $ "route = " <> show route
72-
H.modify_ \state -> state { route = route }
73-
74-
SetApiUrl url -> do
75-
H.modify_ \state -> state { apiUrl = url }
76-
77-
LoadTransaction hash -> do
78-
endpointUrl <- H.get <#> _.apiUrl
79-
H.liftEffect $ log $ "LoadTransaction: requesting transaction " <> hash <> " from " <> endpointUrl
80-
res <- H.liftAff $ Stbx.requestTransaction endpointUrl hash
81-
res # evalTransactionResponse
82-
(\err -> H.liftEffect $ log $ "failed to decode HTTP response into JSON: " <> Affjax.printError err)
83-
(\(Stbx.JsonDecodeError err) -> H.liftEffect $ log $ "Expected to decode a valid Statebox transaction: " <> show err)
84-
(\txError -> H.liftEffect $ log $ "Handling error of received data: " <> show txError)
85-
(\{id, tx} -> do H.modify_ (\state -> state { hashSpace = AdjacencySpace.update Stbx.getPrevious state.hashSpace id tx })
86-
H.liftEffect $ log $ show tx)
87-
88-
LoadTransactions endpointUrl startHash -> do
89-
H.liftEffect $ log $ "LoadTransactions: requesting transactions up to root, starting at " <> startHash <> " from " <> endpointUrl
90-
runProcess txIngester
49+
50+
mkInitialState :: Input -> State
51+
mkInitialState input = input
52+
53+
handleQuery :: ∀ m a. MonadAff m => Query a -> H.HalogenM State Action ChildSlots Void m (Maybe a)
54+
handleQuery = case _ of
55+
LoadTransactionsThenView endpointUrl hash next -> do
56+
handleAction (LoadTransactions endpointUrl hash)
57+
58+
-- after the transaction and its history have been loaded, display it
59+
state <- H.get
60+
let txSumMaybe = AdjacencySpace.lookup hash state.hashSpace
61+
for_ txSumMaybe $ handleAction <<< SelectRoute <<< Route.fromTxSum endpointUrl hash
62+
63+
pure (Just next)
64+
65+
handleAction :: ∀ m. MonadAff m => Action -> HalogenM State Action ChildSlots Void m Unit
66+
handleAction = case _ of
67+
ShowDiagramNodeContent route -> do
68+
handleAction (SelectRoute route)
69+
70+
SelectRoute route -> do
71+
-- H.liftEffect $ log $ "route = " <> show route
72+
H.modify_ \state -> state { route = route }
73+
74+
SetApiUrl url -> do
75+
H.modify_ \state -> state { apiUrl = url }
76+
77+
LoadTransaction hash -> do
78+
endpointUrl <- H.get <#> _.apiUrl
79+
H.liftEffect $ log $ "LoadTransaction: requesting transaction " <> hash <> " from " <> endpointUrl
80+
res <- H.liftAff $ Stbx.requestTransaction endpointUrl hash
81+
res # evalTransactionResponse
82+
(\err -> H.liftEffect $ log $ "failed to decode HTTP response into JSON: " <> Affjax.printError err)
83+
(\(Stbx.JsonDecodeError err) -> H.liftEffect $ log $ "Expected to decode a valid Statebox transaction: " <> show err)
84+
(\txError -> H.liftEffect $ log $ "Handling error of received data: " <> show txError)
85+
(\{id, tx} -> do H.modify_ (\state -> state { hashSpace = AdjacencySpace.update Stbx.getPrevious state.hashSpace id tx })
86+
H.liftEffect $ log $ show tx)
87+
88+
LoadTransactions endpointUrl startHash -> do
89+
H.liftEffect $ log $ "LoadTransactions: requesting transactions up to root, starting at " <> startHash <> " from " <> endpointUrl
90+
runProcess txIngester
91+
where
92+
-- | This ingests transactions produced from the HTTP API into our transaction storage.
93+
txIngester :: Process (HalogenM State Action _ Void m) Unit
94+
txIngester = txProducer `connect` txConsumer
95+
96+
txProducer :: Producer HashTx (HalogenM State Action _ Void m) Unit
97+
txProducer = Stbx.requestTransactionsToRootM endpointUrl startHash
98+
99+
txConsumer :: Consumer HashTx (HalogenM State Action _ Void m) Unit
100+
txConsumer = consumer txStorer
91101
where
92-
-- | This ingests transactions produced from the HTTP API into our transaction storage.
93-
txIngester :: Process (HalogenM State Action _ Void m) Unit
94-
txIngester = txProducer `connect` txConsumer
95-
96-
txProducer :: Producer HashTx (HalogenM State Action _ Void m) Unit
97-
txProducer = Stbx.requestTransactionsToRootM endpointUrl startHash
98-
99-
txConsumer :: Consumer HashTx (HalogenM State Action _ Void m) Unit
100-
txConsumer = consumer txStorer
101-
where
102-
txStorer :: HashTx -> (HalogenM State Action _ Void m) (Maybe _)
103-
txStorer itx@{id, tx} = do
104-
H.modify_ (\state -> state { hashSpace = AdjacencySpace.update Stbx.getPrevious state.hashSpace id tx })
105-
H.liftEffect $ log $ show itx
106-
pure Nothing
107-
108-
LoadPNPRO url -> do
109-
H.liftEffect $ log $ "LoadPNPRO: requesting PNPRO file from " <> url
110-
resE <- H.liftAff $ Affjax.request $ Affjax.defaultRequest { url = url, responseFormat = ResponseFormat.string }
111-
resE # either
112-
(\err -> H.liftEffect $ log $ "failed to decode HTTP response into JSON: " <> Affjax.printError err)
113-
(\res -> do
114-
pnproDocumentE <- H.liftEffect $ try $ PNPRO.fromString res.body
115-
pnproDocumentE # either
116-
(\err -> H.liftEffect $ log $ "Error decoding PNPRO document: " <> show err)
117-
(\pnproDoc -> H.modify_ $ \state -> state { projects = fromPNPROProject pnproDoc.project `cons` state.projects })
118-
)
119-
120-
HandleDiagramEditorMsg (DiagramEditor.OperatorClicked opId) -> do
121-
H.liftEffect $ log $ "DiagramEditor.OperatorClicked: " <> opId
122-
state <- H.get
123-
let
124-
-- TODO #87 we hardcode the assumption here that opId is a net (NetNode opId) but it could be (LeDiagram opId)
125-
newRouteMaybe :: Maybe Route
126-
newRouteMaybe = case state.route of
127-
Diagram pname dname _ -> Just (Diagram pname dname (Just (NetNode opId)))
128-
_ -> Nothing
129-
maybe (pure unit) (handleAction <<< SelectRoute) newRouteMaybe
130-
131-
HandleDiagramEditorMsg (DiagramEditor.OperatorsChanged ops) -> do
132-
state <- H.get
133-
let
134-
projectsUpdatedMaybe :: Maybe (Array Project)
135-
projectsUpdatedMaybe = case state.route of
136-
Diagram pname dname _ ->
137-
modifyProject pname (\p ->
138-
p { diagrams = fromMaybe p.diagrams (modifyDiagramInfo dname (_ {ops = ops}) p.diagrams) }
139-
) state.projects
140-
_ -> Nothing
141-
maybe (pure unit) (\projects -> H.modify_ (_ { projects = projects }) ) projectsUpdatedMaybe
142-
143-
HandleKDMonCatMsg diagramInfo (KDMonCat.Bricks.SelectionChanged selBox) -> do
144-
let boxes = (KDMonCat.Bricks.toBricksInput (DiagramV2.fromOperators diagramInfo.ops) selBox).selectedBoxes
145-
maybe (pure unit) (handleAction <<< HandleDiagramEditorMsg <<< DiagramEditor.OperatorClicked) $ do
146-
box <- Set.findMin boxes
147-
op <- DiagramV2.fromPixel diagramInfo.ops box.bid
148-
pure op.identifier
149-
150-
HandlePetrinetEditorMsg NetUpdated -> do
151-
pure unit
102+
txStorer :: HashTx -> (HalogenM State Action _ Void m) (Maybe _)
103+
txStorer itx@{id, tx} = do
104+
H.modify_ (\state -> state { hashSpace = AdjacencySpace.update Stbx.getPrevious state.hashSpace id tx })
105+
H.liftEffect $ log $ show itx
106+
pure Nothing
107+
108+
LoadPNPRO url -> do
109+
H.liftEffect $ log $ "LoadPNPRO: requesting PNPRO file from " <> url
110+
resE <- H.liftAff $ Affjax.request $ Affjax.defaultRequest { url = url, responseFormat = ResponseFormat.string }
111+
resE # either
112+
(\err -> H.liftEffect $ log $ "failed to decode HTTP response into JSON: " <> Affjax.printError err)
113+
(\res -> do
114+
pnproDocumentE <- H.liftEffect $ try $ PNPRO.fromString res.body
115+
pnproDocumentE # either
116+
(\err -> H.liftEffect $ log $ "Error decoding PNPRO document: " <> show err)
117+
(\pnproDoc -> H.modify_ $ \state -> state { projects = fromPNPROProject pnproDoc.project `cons` state.projects })
118+
)
119+
120+
HandleDiagramEditorMsg (DiagramEditor.OperatorClicked opId) -> do
121+
H.liftEffect $ log $ "DiagramEditor.OperatorClicked: " <> opId
122+
state <- H.get
123+
let
124+
-- TODO #87 we hardcode the assumption here that opId is a net (NetNode opId) but it could be (LeDiagram opId)
125+
newRouteMaybe :: Maybe Route
126+
newRouteMaybe = case state.route of
127+
Diagram pname dname _ -> Just (Diagram pname dname (Just (NetNode opId)))
128+
_ -> Nothing
129+
maybe (pure unit) (handleAction <<< SelectRoute) newRouteMaybe
130+
131+
HandleDiagramEditorMsg (DiagramEditor.OperatorsChanged ops) -> do
132+
state <- H.get
133+
let
134+
projectsUpdatedMaybe :: Maybe (Array Project)
135+
projectsUpdatedMaybe = case state.route of
136+
Diagram pname dname _ ->
137+
modifyProject pname (\p ->
138+
p { diagrams = fromMaybe p.diagrams (modifyDiagramInfo dname (_ {ops = ops}) p.diagrams) }
139+
) state.projects
140+
_ -> Nothing
141+
maybe (pure unit) (\projects -> H.modify_ (_ { projects = projects }) ) projectsUpdatedMaybe
142+
143+
HandleKDMonCatMsg diagramInfo (KDMonCat.Bricks.SelectionChanged selBox) -> do
144+
let boxes = (KDMonCat.Bricks.toBricksInput (DiagramV2.fromOperators diagramInfo.ops) selBox).selectedBoxes
145+
maybe (pure unit) (handleAction <<< HandleDiagramEditorMsg <<< DiagramEditor.OperatorClicked) $ do
146+
box <- Set.findMin boxes
147+
op <- DiagramV2.fromPixel diagramInfo.ops box.bid
148+
pure op.identifier
149+
150+
HandlePetrinetEditorMsg NetUpdated -> do
151+
pure unit

0 commit comments

Comments
 (0)