From 2b8a640427f879fe6cfccadd3413f03e28311120 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 3 Feb 2024 18:57:38 +0100 Subject: [PATCH] Errors are displayed in a fancy way. --- src/App/ZoneInterface.purs | 61 ++++++++++++++++++++++++++++---------- src/Bulma.purs | 28 ++++++++++++++--- src/CSSClasses.purs | 22 ++++++++++++++ 3 files changed, 91 insertions(+), 20 deletions(-) diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 40d9128..7315652 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -33,7 +33,7 @@ import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Array.NonEmpty as NonEmpty import Data.Either (Either(..)) import Data.Foldable as Foldable -import Data.Maybe (Maybe(..), fromMaybe) +import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.String as S import Data.String.Regex as Regex import Data.String.Regex.Flags as RegexFlags @@ -55,6 +55,9 @@ import App.ResourceRecord (ResourceRecord) import App.LogMessage (LogMessage(..)) import App.Messages.DNSManagerDaemon as DNSManager import App.Validation as Validation +import GenericParser.DomainParser.Common as DomainParser +import GenericParser.DomainParser as DomainParser + id :: forall a. a -> a id x = x @@ -284,7 +287,7 @@ render state updateForm x = UpdateNewRRForm <<< x render_errors = if A.length state._newRR_errors > 0 then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors - else HH.div_ [ Bulma.h3 "No error for now! ;)" ] + else HH.div_ [ ] content_simple :: String -> Array (HH.HTML w Action) content_simple t = [ render_errors @@ -385,6 +388,7 @@ handleAction = case _ of -- | Works for both "remove RR" and "new RR" modals. CancelModal -> do H.modify_ _ { active_modal = Nothing, active_new_rr_modal = Nothing } + H.modify_ _ { _newRR_errors = [] } -- | Create the RR modal. DeleteRRModal rr_id -> do @@ -1046,22 +1050,47 @@ getNewID state = (_ + 1) maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr error_to_paragraph :: forall w. Validation.ValidationError -> HH.HTML w Action -error_to_paragraph v = Bulma.p $ show_error v +error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error v) + (case v of + Validation.UNKNOWN -> Bulma.p "An internal error happened." + Validation.VEIPv4 err -> Bulma.p "put the actual error here" + Validation.VEIPv6 err -> Bulma.p "put the actual error here" + Validation.VEName err -> maybe (Bulma.p "no actual error reported") show_error_domain err.error + Validation.VETTL err -> Bulma.p "put the actual error here" + Validation.VETXT err -> Bulma.p "put the actual error here" + Validation.VECNAME err -> Bulma.p "put the actual error here" + Validation.VENS err -> Bulma.p "put the actual error here" + Validation.VEMX err -> Bulma.p "put the actual error here" + Validation.VEPriority err -> Bulma.p "put the actual error here" + Validation.VESRV err -> Bulma.p "put the actual error here" + Validation.VEProtocol err -> Bulma.p "put the actual error here" + Validation.VEPort err -> Bulma.p "put the actual error here" + Validation.VEWeight err -> Bulma.p "put the actual error here" +-- Nothing -> "no error reported" +-- Just e -> "error reported, will soon appear!" + ) -- | `show_error` provide a string to display to the user in case of an error with an entry. show_error :: Validation.ValidationError -> String show_error v = case v of Validation.UNKNOWN -> "Unknown" - Validation.VEIPv4 err -> "VEIPv4 pos: " <> show err.position - Validation.VEIPv6 err -> "VEIPv6 pos: " <> show err.position - Validation.VEName err -> "VEName pos: " <> show err.position - Validation.VETTL err -> "VETTL pos: " <> show err.position - Validation.VETXT err -> "VETXT pos: " <> show err.position - Validation.VECNAME err -> "VECNAME pos: " <> show err.position - Validation.VENS err -> "VENS pos: " <> show err.position - Validation.VEMX err -> "VEMX pos: " <> show err.position - Validation.VEPriority err -> "VEPriority pos: " <> show err.position - Validation.VESRV err -> "VESRV pos: " <> show err.position - Validation.VEProtocol err -> "VEProtocol pos: " <> show err.position - Validation.VEPort err -> "VEPort pos: " <> show err.position - Validation.VEWeight err -> "VEWeight pos: " <> show err.position + Validation.VEIPv4 err -> "The IPv4 address is wrong (position: " <> show err.position <> ")" + Validation.VEIPv6 err -> "The IPv6 address is wrong (position: " <> show err.position <> ")" + Validation.VEName err -> "The name (domain label) is wrong (position: " <> show err.position <> ")" + Validation.VETTL err -> "The TTL input is wrong (position: " <> show err.position <> ")" + Validation.VETXT err -> "The TXT input is wrong (position: " <> show err.position <> ")" + Validation.VECNAME err -> "The CNAME input is wrong (position: " <> show err.position <> ")" + Validation.VENS err -> "The NS input is wrong (position: " <> show err.position <> ")" + Validation.VEMX err -> "The MX target input is wrong (position: " <> show err.position <> ")" + Validation.VEPriority err -> "The Priority input is wrong (position: " <> show err.position <> ")" + Validation.VESRV err -> "The SRV target input is wrong (position: " <> show err.position <> ")" + Validation.VEProtocol err -> "The Protocol input is wrong (position: " <> show err.position <> ")" + Validation.VEPort err -> "The Port input is wrong (position: " <> show err.position <> ")" + Validation.VEWeight err -> "The Weight input is wrong (position: " <> show err.position <> ")" + +show_error_domain :: forall w. DomainParser.DomainError -> HH.HTML w Action +show_error_domain e = case e of + DomainParser.LabelTooLarge size -> Bulma.p $ "LabelTooLarge (" <> show size <> " characters)" + DomainParser.DomainTooLarge size -> Bulma.p $ "DomainTooLarge (" <> show size <> " characters)" + DomainParser.InvalidCharacter -> Bulma.p "InvalidCharacter" + DomainParser.EOFExpected -> Bulma.p "EOFExpected" diff --git a/src/Bulma.purs b/src/Bulma.purs index 86c156e..ec058b7 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -275,7 +275,6 @@ btn_change action1 action2 modified validity , HP.classes $ btn_classes validity ] [ HH.text "save" ] where - btn_change_action = case _ of true -> HE.onClick \_ -> action1 _ -> HE.onClick \_ -> action2 @@ -287,7 +286,6 @@ btn_delete action , HP.classes [ HH.ClassName "button is-small is-danger" ] ] [ HH.text "remove" ] - btn_add :: forall w i. i -> i -> Boolean -> HH.HTML w i btn_add action1 action2 validity = HH.button @@ -354,6 +352,7 @@ field_inner ispassword id title placeholder action value validity cond box_input :: forall w i. String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i box_input = field_inner false + box_password :: forall w i. String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i box_password = field_inner true @@ -502,5 +501,26 @@ strong str = HH.strong_ [ HH.text str ] hr :: forall w i. HH.HTML w i hr = HH.hr_ -tile :: forall w i. Array (HH.HTML w i) -> HH.HTML w i -tile = HH.div [HP.classes (C.tile <> C.is_primary <> C.box)] +tile :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i +tile classes = HH.div [HP.classes (C.tile <> classes)] + +tile_ :: forall w i. Array (HH.HTML w i) -> HH.HTML w i +tile_ = tile [] + +tile_danger :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i +tile_danger classes = tile (C.is_danger <> C.notification <> classes) + +tile_warning :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i +tile_warning classes = tile (C.is_warning <> C.notification <> classes) + +article_ :: forall w i. Array HH.ClassName -> HH.HTML w i -> HH.HTML w i -> HH.HTML w i +article_ classes head body = HH.article [HP.classes (C.message <> classes)] + [ HH.div [HP.classes C.message_header] [head] + , HH.div [HP.classes C.message_body ] [body] + ] + +article :: forall w i. HH.HTML w i -> HH.HTML w i -> HH.HTML w i +article head body = article_ [] head body + +error_message :: forall w i. HH.HTML w i -> HH.HTML w i -> HH.HTML w i +error_message head body = article_ C.is_danger head body diff --git a/src/CSSClasses.purs b/src/CSSClasses.purs index abeed22..5658870 100644 --- a/src/CSSClasses.purs +++ b/src/CSSClasses.purs @@ -2,6 +2,28 @@ module CSSClasses where import Halogen.HTML as HH +is_ancestor :: Array HH.ClassName +is_ancestor = [HH.ClassName "is-ancestor"] +is_vertical :: Array HH.ClassName +is_vertical = [HH.ClassName "is-vertical"] +is_parent :: Array HH.ClassName +is_parent = [HH.ClassName "is-parent"] +is_child :: Array HH.ClassName +is_child = [HH.ClassName "is-child"] +notification :: Array HH.ClassName +notification = [HH.ClassName "notification"] +is_warning :: Array HH.ClassName +is_warning = [HH.ClassName "is-warning"] + +message :: Array HH.ClassName +message = [HH.ClassName "message"] + +message_header :: Array HH.ClassName +message_header = [HH.ClassName "message-header"] + +message_body :: Array HH.ClassName +message_body = [HH.ClassName "message-body"] + box :: Array HH.ClassName box = [HH.ClassName "box"] button :: Array HH.ClassName