git.iko.soy/typeable/octopod
on master help sign in
Resolved metadata event passthrough issue (#170)
commit857a4ee74b12cc061a45ca1e033f230cbbccce99 authoriko <ilyakooo0@gmail.com> dateMon 6 Jun 2022, 11:02 (4 years ago) parenta296882
7 files changed+38−24
.vscode/settings.json+2−1 octopod-frontend/src/Frontend/UIKit/Button/Action.hs+1−1 octopod-frontend/src/Frontend/UIKit/Button/Common.hs+11−7 octopod-frontend/src/Frontend/UIKit/Button/Large.hs+1−1 octopod-frontend/src/Page/Deployment.hs+1−1 octopod-frontend/src/Page/Deployments.hs+2−2 octopod-frontend/src/Page/Elements/Links.hs+20−11
.vscode/settings.json+2−1
@@ -4,5 +4,6 @@
44 "haskell.plugin.hlint.diagnosticsOn": false,
55 "haskell.hlint.logLevel": "none",
66 "haskell.hlint.run": "never",
7− "haskell.serverExecutablePath": "haskell-language-server"
7+ "haskell.serverExecutablePath": "haskell-language-server",
8+ "editor.formatOnSave": true
89}
octopod-frontend/src/Frontend/UIKit/Button/Action.hs+1−1
@@ -18,7 +18,7 @@ data ActionButtonConfig t = ActionButtonConfig
1818 { buttonText :: Text
1919 , buttonEnabled :: Dynamic t Bool
2020 , buttonType :: Maybe ActionButtonType
21− , buttonBaseTag :: BaseButtonTag
21+ , buttonBaseTag :: BaseButtonTag t
2222 }
2323 deriving stock (Generic)
2424
octopod-frontend/src/Frontend/UIKit/Button/Common.hs+11−7
@@ -39,15 +39,18 @@ data CommonButtonConfig t = CommonButtonConfig
3939 , disabledClasses :: Classes
4040 , buttonEnabled :: Dynamic t Bool
4141 , buttonText :: TextBuilder t
42− , buttonBaseTag :: BaseButtonTag
42+ , buttonBaseTag :: BaseButtonTag t
4343 }
4444 deriving stock (Generic)
4545
46−data BaseButtonTag = ButtonTag | ATag Text
46+data BaseButtonTag t = ButtonTag | ATag (Dynamic t Text)
4747
48−baseTag :: BaseButtonTag -> (Text, Map Text Text)
49−baseTag ButtonTag = ("button", "type" =: "button")
50−baseTag (ATag url) = ("a", "href" =: url <> "target" =: "_blank")
48+baseTag :: Reflex t => BaseButtonTag t -> (Text, Dynamic t (Map Text Text))
49+baseTag ButtonTag = ("button", pure $ "type" =: "button")
50+baseTag (ATag urlDyn) =
51+ ( "a"
52+ , urlDyn <&> \url -> "href" =: url <> "target" =: "_blank"
53+ )
5154
5255buttonEl ::
5356 forall m t.
@@ -55,15 +58,16 @@ buttonEl ::
5558 CommonButtonConfig t ->
5659 m (Event t (Either () ()))
5760buttonEl cfg = do
58− let (t, staticAttrs) = baseTag (cfg ^. #buttonBaseTag)
61+ let (t, tagAttrsDyn) = baseTag (cfg ^. #buttonBaseTag)
5962 attrsDyn = do
6063 enabled <- cfg ^. #buttonEnabled
6164 let (enabledClasses, enabledAttrs) = case enabled of
6265 True -> (cfg ^. #enabledClasses, mempty)
6366 False -> (cfg ^. #disabledClasses, "disabled" =: "")
6467 cs <- cfg ^. #constantClasses
68+ tagAttrs <- tagAttrsDyn
6569 pure $
66− staticAttrs
70+ tagAttrs
6771 <> "class" =: destructClasses (enabledClasses <> cs)
6872 <> enabledAttrs
6973 modAttrs <- dynamicAttributesToModifyAttributes attrsDyn
octopod-frontend/src/Frontend/UIKit/Button/Large.hs+1−1
@@ -23,7 +23,7 @@ data LargeButtonConfig t = LargeButtonConfig
2323 , buttonType :: Dynamic t (Maybe LargeButtonType)
2424 , buttonPriority :: LargeButtonPriority
2525 , buttonStyle :: LargeButtonStyle
26− , buttonBaseTag :: BaseButtonTag
26+ , buttonBaseTag :: BaseButtonTag t
2727 }
2828 deriving stock (Generic)
2929
octopod-frontend/src/Page/Deployment.hs+1−1
@@ -158,7 +158,7 @@ deploymentHead dfiDyn sentEv =
158158 , buttonType = pure $ Just LogsLargeButtonType
159159 , buttonPriority = SecondaryLargeButton
160160 , buttonStyle = PageActionLargeButtonStyle
161− , buttonBaseTag = ATag url
161+ , buttonBaseTag = ATag $ pure url
162162 }
163163 )
164164 delEv <- confirmArchivePopup (archEv $> ()) $ do
octopod-frontend/src/Page/Deployments.hs+2−2
@@ -295,7 +295,7 @@ activeDeploymentWidget dDyn' = do
295295 def
296296 { buttonText = "Details"
297297 , buttonType = Just LogsActionButtonType
298− , buttonBaseTag = ATag url
298+ , buttonBaseTag = ATag $ pure url
299299 }
300300 )
301301 pure $
@@ -379,7 +379,7 @@ archivedDeploymentWidget dDyn' = do
379379 btnEv <- dropdownWidget body
380380 void $ restoreEndpoint (constDyn $ Right $ dName) (btnEv $> ())
381381 let route = DashboardRoute :/ Just dName
382− setRoute $ route <$ domEvent Dblclick linkEl
382+ setRoute $ route <$ domEvent Click linkEl
383383
384384-- | Sort deployments by the supplied condition.
385385sortDeployments ::
octopod-frontend/src/Page/Elements/Links.hs+20−11
@@ -4,8 +4,11 @@ module Page.Elements.Links
44where
55
66import Common.Types
7+import Common.Utils ((<^.>))
78import Control.Lens
9+import Control.Monad
810import qualified Data.Text as T
11+import Frontend.UIKit.Button.Common
912import Reflex.Dom
1013
1114renderMetadataLink ::
@@ -13,14 +16,20 @@ renderMetadataLink ::
1316 Dynamic t DeploymentMetadatum ->
1417 m ()
1518renderMetadataLink metadataD = do
16− let attrDyn =
17− metadataD <&> \metadata ->
18− "class" =: "listing__item external bar bar--larger"
19− <> "href" =: metadata ^. #link
20− <> "target" =: "_blank"
21− elDynAttr "a" attrDyn . dynText $
22− metadataD <&> \case
23− -- If the name is empty, then use the url
24− DeploymentMetadatum {name = name}
25− | (not . T.null . T.strip) name -> name
26− DeploymentMetadatum {link = url} -> url
19+ void $
20+ buttonEl
21+ CommonButtonConfig
22+ { constantClasses = pure $ "listing__item" <> "external" <> "bar" <> "bar--larger"
23+ , enabledClasses = mempty
24+ , disabledClasses = "button--disabled"
25+ , buttonEnabled = pure True
26+ , buttonText =
27+ TextBuilder $
28+ dynText $
29+ metadataD <&> \case
30+ -- If the name is empty, then use the url
31+ DeploymentMetadatum {name = name}
32+ | (not . T.null . T.strip) name -> name
33+ DeploymentMetadatum {link = url} -> url
34+ , buttonBaseTag = ATag $ metadataD <^.> #link
35+ }