diff --git a/src/View/Common.purs b/src/View/Common.purs index e99c51ed..bec3eb5c 100644 --- a/src/View/Common.purs +++ b/src/View/Common.purs @@ -15,3 +15,6 @@ styleStr kvs = HP.attr (HC.AttrName "style") (intercalate ";" <<< map (\(k /\ v) emptyHtml :: ∀ a b. HTML b a emptyHtml = text "" + +classesWithNames :: ∀ r i. Array String -> HP.IProp (class :: String | r) i +classesWithNames names = HP.classes (HC.ClassName <$> names) diff --git a/src/View/Petrinet/TransitionEditor.purs b/src/View/Petrinet/TransitionEditor.purs index 098f5f45..dec809c9 100644 --- a/src/View/Petrinet/TransitionEditor.purs +++ b/src/View/Petrinet/TransitionEditor.purs @@ -20,7 +20,7 @@ import Halogen.HTML.Properties (classes, disabled, src, width, height, type_, va import Data.Auth (Role(..), Roles(..), Privilege(..), RoleInfo, rolesElem, isPrivileged, toPrivilege, CSSColor(..)) import Data.Auth as Auth import View.Petrinet.Model (TransitionQueryF(..), Typedef(..)) -import View.Common (styleStr) +import View.Common (styleStr, classesWithNames) type TransitionEditorFormModel tid = { tid :: tid @@ -38,14 +38,14 @@ form allRoleInfos mm = titledPanel "Transition properties" $ formContainer [ fieldContainer "name" "grid-label-name" $ - input [ clzz inputClasses1 + input [ classesWithNames inputClasses1 , value (maybe "" (_.label) mm) , maybe (disabled true) (\tid -> onValueChange (HE.input (UpdateTransitionName tid))) (mm <#> _.tid) ] , fieldContainer "type" "grid-label-type" $ - input [ clzz inputClasses1 + input [ classesWithNames inputClasses1 , value (maybe "" (un Typedef <<< _.typedef) mm) , maybe (disabled true) (\tid -> onValueChange (HE.input (UpdateTransitionType tid <<< Typedef))) @@ -56,27 +56,27 @@ form allRoleInfos mm = ] where titledPanel title content = - div [ clzz [ "mb-2", "border-solid", "border-grey-light", "rounded", "border", "shadow-sm" ] ] - [ div [ clzz [ "bg-grey-lighter", "px-2", "py-3", "border-solid", "border-grey-light", "border-b", "text-grey-darker" ] ] + div [ classesWithNames [ "mb-2", "border-solid", "border-grey-light", "rounded", "border", "shadow-sm" ] ] + [ div [ classesWithNames [ "bg-grey-lighter", "px-2", "py-3", "border-solid", "border-grey-light", "border-b", "text-grey-darker" ] ] [ text title ] , content ] formContainer formContent = - div [ clzz [ "bg-white", "rounded", "flex", "flex-col", "px-4", "pt-6" ] ] + div [ classesWithNames [ "bg-white", "rounded", "flex", "flex-col", "px-4", "pt-6" ] ] formContent fieldContainer :: String -> String -> HTML _ _ -> HTML _ _ fieldContainer labelText forInputId content = - div [ clzz [ "-mx-3", "md:flex", "mb-6" ] ] - [ div [ clzz [ "md:w-full", "px-3" ] ] + div [ classesWithNames [ "-mx-3", "md:flex", "mb-6" ] ] + [ div [ classesWithNames [ "md:w-full", "px-3" ] ] [ label1 forInputId labelText , content ] ] label1 forInputId labelText = - HH.label [ clzz [ "block", "uppercase", "tracking-wide", "text-grey-darker", "text-xs", "font-bold", "mb-2" ] + HH.label [ classesWithNames [ "block", "uppercase", "tracking-wide", "text-grey-darker", "text-xs", "font-bold", "mb-2" ] , HP.for forInputId ] [ text labelText ] @@ -91,7 +91,7 @@ form allRoleInfos mm = authCheckboxes :: Roles -> Array (HTML _ _) authCheckboxes roles = checkboxContainer <<< (\roleInfo -> roleCheckbox allRoleInfosDict roleInfo $ priv roles roleInfo.id) <$> allRoleInfos where - checkboxContainer html = div [ clzz [ "mt-4", "mb-4" ] ] [ html ] + checkboxContainer html = div [ classesWithNames [ "mt-4", "mb-4" ] ] [ html ] priv :: Roles -> Role -> Privilege priv privilegedRoles role = toPrivilege <<< rolesElem role $ privilegedRoles @@ -121,6 +121,3 @@ roleTagHtml roleInfosDict role = backgroundColor = maybe (CSSColor "#ddd") _.bgColor roleInfoMaybe textColor = maybe (CSSColor "#666") _.textColor roleInfoMaybe roleInfoMaybe = Map.lookup role roleInfosDict - -clzz :: Array String -> H.IProp _ _ -clzz strs = classes (ClassName <$> strs) diff --git a/src/View/Studio/ObjectTree.purs b/src/View/Studio/ObjectTree.purs index 539b1bec..9e4650a0 100644 --- a/src/View/Studio/ObjectTree.purs +++ b/src/View/Studio/ObjectTree.purs @@ -19,6 +19,7 @@ import Halogen.HTML.Properties (classes, src, href) import Halogen.HTML.Properties.ARIA as ARIA import View.Studio.Route (Route, RouteF(..)) +import View.Common (classesWithNames) -------------------------------------------------------------------------------- @@ -97,29 +98,29 @@ menuComponent isSelected = render :: State -> HTML Void (Query Unit) render state = fromMaybe (div [] []) $ state.tree <#> \tree -> - nav [ clzz [ componentCssClassNameStr, "p-4" ] ] - [ ul [ clzz [ "list-reset" ] ] $ + nav [ classesWithNames [ componentCssClassNameStr, "p-4" ] ] + [ ul [ classesWithNames [ "list-reset" ] ] $ if state.hideRoot then (semifoldCofree menuItemHtml <$> tail tree) else [semifoldCofree menuItemHtml $ tree] ] where menuItemHtml :: Item -> Array (HTML Void (Query Unit)) -> HTML Void (Query Unit) menuItemHtml treeNode kids = - li [ clzz ([ "block", "flex", "cursor-pointer", "px-2", "py-2", "text-grey-darkest" ] <> activeClasses)] + li [ classesWithNames ([ "block", "flex", "cursor-pointer", "px-2", "py-2", "text-grey-darkest" ] <> activeClasses)] [ div [] [ arrowIcon - , span [ clzz [ "pl-2" ] + , span [ classesWithNames [ "pl-2" ] , onClick (HE.input_ clickQuery) ] [ text treeNode.label ] - , if isExpanded then ul [ clzz [ "list-reset", "mt-2" ] ] kids - else span [ clzz [ "no-children" ] ] [] + , if isExpanded then ul [ classesWithNames [ "list-reset", "mt-2" ] ] kids + else span [ classesWithNames [ "no-children" ] ] [] ] ] where activeClasses = if isActive then [ "is-active", "bg-purple-darker", "text-purple-lighter", "rounded" ] else [] arrowIcon = if null kids then text "" - else span [ clzz [ "fas" , "fa-xs" + else span [ classesWithNames [ "fas" , "fa-xs" , "fa-caret-" <> if isExpanded then "down" else "right" ] , onClick (HE.input_ clickQuery) @@ -131,8 +132,5 @@ menuComponent isSelected = isExpanded = not null kids && (fromMaybe true $ Map.lookup treeNode.id state.expansion) isActive = state.activeItem == pure treeNode.id -clzz :: Array String -> _ -clzz classStrs = classes (ClassName <$> classStrs) - semifoldCofree :: forall f a b. Functor f => (a -> f b -> b) -> Cofree f a -> b semifoldCofree f1 tree = f1 (head tree) (semifoldCofree f1 <$> tail tree)