karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

WIP: SPF. Can now remove mechanisms.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-03-01 03:23:54 +01:00
parent e21ff35835
commit e893a6dca2
1 changed files with 29 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/App/ZoneInterface.purs
View File

@ -21,10 +21,11 @@ module App.ZoneInterface where
import Prelude (Unit, unit, void import Prelude (Unit, unit, void
, bind, pure , bind, pure
, not, comparing, discard, map, show , not, comparing, discard, map, show
, (&&), ($), (/=), (<<<), (<>), (==), (>), (#)) , (+), (&&), ($), (/=), (<<<), (<>), (==), (>), (#))
import Data.Array as A import Data.Array as A
import Data.Int (fromString) import Data.Int (fromString)
import Data.Tuple (Tuple(..))
import Data.ArrayBuffer.Types (ArrayBuffer) import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..)) import Data.Either (Either(..))
@ -151,6 +152,8 @@ data Action
| SPF_Modifier Int | SPF_Modifier Int
| SPF_Qualifier Int | SPF_Qualifier Int
| SPF_remove_mechanism Int
| SPF_Mechanism_Add | SPF_Mechanism_Add
data RRModal data RRModal
@ -561,6 +564,12 @@ handleAction = case _ of
SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v } SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v }
SPF_Modifier v -> H.modify_ _ { spf_modifier = maybe "redirect" id $ modifier_types A.!! v } SPF_Modifier v -> H.modify_ _ { spf_modifier = maybe "redirect" id $ modifier_types A.!! v }
SPF_Qualifier v -> H.modify_ _ { spf_qualifier = maybe "none" id $ qualifier_types A.!! v } SPF_Qualifier v -> H.modify_ _ { spf_qualifier = maybe "none" id $ qualifier_types A.!! v }
SPF_remove_mechanism i ->
H.modify_ \s -> s { _currentRR { mechanisms = case s._currentRR.mechanisms of
Just ms -> Just (remove_id i $ attach_id 0 ms)
Nothing -> Nothing
} }
SPF_Mechanism_Add -> do SPF_Mechanism_Add -> do
state <- H.get state <- H.get
let m = state._currentRR.mechanisms let m = state._currentRR.mechanisms
@ -786,14 +795,14 @@ render_resources records
display_mechanisms :: forall w. Array RR.Mechanism -> HH.HTML w Action display_mechanisms :: forall w. Array RR.Mechanism -> HH.HTML w Action
display_mechanisms ms = display_mechanisms ms =
Bulma.box_ C.has_background_warning_light Bulma.box_ C.has_background_warning_light
[ Bulma.table [] [ Bulma.mechanism_table_header, HH.tbody_ $ map render_mechanism_row ms] ] [ Bulma.table [] [ Bulma.mechanism_table_header, HH.tbody_ $ map render_mechanism_row $ attach_id 0 ms] ]
where where
render_mechanism_row :: RR.Mechanism -> HH.HTML w Action render_mechanism_row :: (Tuple Int RR.Mechanism) -> HH.HTML w Action
render_mechanism_row m = HH.tr_ render_mechanism_row (Tuple i m) = HH.tr_
[ Bulma.txt_name $ maybe "" show_qualifier m.q [ Bulma.txt_name $ "(" <> show i <> ") " <> maybe "" show_qualifier m.q
, HH.td_ [ Bulma.p $ show_mechanism_type m.t ] , HH.td_ [ Bulma.p $ show_mechanism_type m.t ]
, HH.td_ [ Bulma.p m.v ] , HH.td_ [ Bulma.p m.v ]
, HH.td_ [ Bulma.btn_readonly ] , HH.td_ [ Bulma.alert_btn "x" (SPF_remove_mechanism i) ]
] ]
baseRecords :: Array String baseRecords :: Array String
@ -861,3 +870,17 @@ update_field rr updated_field = case updated_field of
Field_SPF_mechanisms val -> rr { mechanisms = Just val } Field_SPF_mechanisms val -> rr { mechanisms = Just val }
Field_SPF_modifiers val -> rr { modifiers = Just val } Field_SPF_modifiers val -> rr { modifiers = Just val }
Field_SPF_q val -> rr { q = Just val } Field_SPF_q val -> rr { q = Just val }
attach_id :: forall a. Int -> Array a -> Array (Tuple Int a)
attach_id _ [] = []
attach_id i arr = case A.head arr of
Just x -> [Tuple i x] <> attach_id (i + 1) (fromMaybe [] $ A.tail arr)
Nothing -> []
remove_id :: forall a. Int -> Array (Tuple Int a) -> Array a
remove_id _ [] = []
remove_id i arr = case A.head arr of
Just (Tuple n x) -> if i == n
then remove_id i (fromMaybe [] $ A.tail arr)
else [x] <> remove_id i (fromMaybe [] $ A.tail arr)
Nothing -> []