Errors are displayed in a fancy way.

beta
Philippe Pittoli 2024-02-03 18:57:38 +01:00
parent 4a10ffa4e3
commit 2b8a640427
3 changed files with 91 additions and 20 deletions

View File

@ -33,7 +33,7 @@ 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(..))
import Data.Foldable as Foldable import Data.Foldable as Foldable
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.String as S import Data.String as S
import Data.String.Regex as Regex import Data.String.Regex as Regex
import Data.String.Regex.Flags as RegexFlags import Data.String.Regex.Flags as RegexFlags
@ -55,6 +55,9 @@ import App.ResourceRecord (ResourceRecord)
import App.LogMessage (LogMessage(..)) import App.LogMessage (LogMessage(..))
import App.Messages.DNSManagerDaemon as DNSManager import App.Messages.DNSManagerDaemon as DNSManager
import App.Validation as Validation import App.Validation as Validation
import GenericParser.DomainParser.Common as DomainParser
import GenericParser.DomainParser as DomainParser
id :: forall a. a -> a id :: forall a. a -> a
id x = x id x = x
@ -284,7 +287,7 @@ render state
updateForm x = UpdateNewRRForm <<< x updateForm x = UpdateNewRRForm <<< x
render_errors = if A.length state._newRR_errors > 0 render_errors = if A.length state._newRR_errors > 0
then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors 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 :: String -> Array (HH.HTML w Action)
content_simple t = content_simple t =
[ render_errors [ render_errors
@ -385,6 +388,7 @@ handleAction = case _ of
-- | Works for both "remove RR" and "new RR" modals. -- | Works for both "remove RR" and "new RR" modals.
CancelModal -> do CancelModal -> do
H.modify_ _ { active_modal = Nothing, active_new_rr_modal = Nothing } H.modify_ _ { active_modal = Nothing, active_new_rr_modal = Nothing }
H.modify_ _ { _newRR_errors = [] }
-- | Create the RR modal. -- | Create the RR modal.
DeleteRRModal rr_id -> do DeleteRRModal rr_id -> do
@ -1046,22 +1050,47 @@ getNewID state = (_ + 1)
maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr
error_to_paragraph :: forall w. Validation.ValidationError -> HH.HTML w Action 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` provide a string to display to the user in case of an error with an entry.
show_error :: Validation.ValidationError -> String show_error :: Validation.ValidationError -> String
show_error v = case v of show_error v = case v of
Validation.UNKNOWN -> "Unknown" Validation.UNKNOWN -> "Unknown"
Validation.VEIPv4 err -> "VEIPv4 pos: " <> show err.position Validation.VEIPv4 err -> "The IPv4 address is wrong (position: " <> show err.position <> ")"
Validation.VEIPv6 err -> "VEIPv6 pos: " <> show err.position Validation.VEIPv6 err -> "The IPv6 address is wrong (position: " <> show err.position <> ")"
Validation.VEName err -> "VEName pos: " <> show err.position Validation.VEName err -> "The name (domain label) is wrong (position: " <> show err.position <> ")"
Validation.VETTL err -> "VETTL pos: " <> show err.position Validation.VETTL err -> "The TTL input is wrong (position: " <> show err.position <> ")"
Validation.VETXT err -> "VETXT pos: " <> show err.position Validation.VETXT err -> "The TXT input is wrong (position: " <> show err.position <> ")"
Validation.VECNAME err -> "VECNAME pos: " <> show err.position Validation.VECNAME err -> "The CNAME input is wrong (position: " <> show err.position <> ")"
Validation.VENS err -> "VENS pos: " <> show err.position Validation.VENS err -> "The NS input is wrong (position: " <> show err.position <> ")"
Validation.VEMX err -> "VEMX pos: " <> show err.position Validation.VEMX err -> "The MX target input is wrong (position: " <> show err.position <> ")"
Validation.VEPriority err -> "VEPriority pos: " <> show err.position Validation.VEPriority err -> "The Priority input is wrong (position: " <> show err.position <> ")"
Validation.VESRV err -> "VESRV pos: " <> show err.position Validation.VESRV err -> "The SRV target input is wrong (position: " <> show err.position <> ")"
Validation.VEProtocol err -> "VEProtocol pos: " <> show err.position Validation.VEProtocol err -> "The Protocol input is wrong (position: " <> show err.position <> ")"
Validation.VEPort err -> "VEPort pos: " <> show err.position Validation.VEPort err -> "The Port input is wrong (position: " <> show err.position <> ")"
Validation.VEWeight err -> "VEWeight pos: " <> 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"

View File

@ -275,7 +275,6 @@ btn_change action1 action2 modified validity
, HP.classes $ btn_classes validity , HP.classes $ btn_classes validity
] [ HH.text "save" ] ] [ HH.text "save" ]
where where
btn_change_action = case _ of btn_change_action = case _ of
true -> HE.onClick \_ -> action1 true -> HE.onClick \_ -> action1
_ -> HE.onClick \_ -> action2 _ -> HE.onClick \_ -> action2
@ -287,7 +286,6 @@ btn_delete action
, HP.classes [ HH.ClassName "button is-small is-danger" ] , HP.classes [ HH.ClassName "button is-small is-danger" ]
] [ HH.text "remove" ] ] [ HH.text "remove" ]
btn_add :: forall w i. i -> i -> Boolean -> HH.HTML w i btn_add :: forall w i. i -> i -> Boolean -> HH.HTML w i
btn_add action1 action2 validity btn_add action1 action2 validity
= HH.button = HH.button
@ -354,6 +352,7 @@ field_inner ispassword id title placeholder action value validity cond
box_input :: forall w i. box_input :: forall w i.
String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
box_input = field_inner false box_input = field_inner false
box_password :: forall w i. box_password :: forall w i.
String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
box_password = field_inner true 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 :: forall w i. HH.HTML w i
hr = HH.hr_ hr = HH.hr_
tile :: forall w i. Array (HH.HTML w i) -> HH.HTML w i tile :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
tile = HH.div [HP.classes (C.tile <> C.is_primary <> C.box)] 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

View File

@ -2,6 +2,28 @@ module CSSClasses where
import Halogen.HTML as HH 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 :: Array HH.ClassName
box = [HH.ClassName "box"] box = [HH.ClassName "box"]
button :: Array HH.ClassName button :: Array HH.ClassName