From 59b3e43bb02060522b45875464761ac3f7b9ec51 Mon Sep 17 00:00:00 2001 From: Christophe de Vienne Date: Fri, 21 May 2021 23:42:34 +0200 Subject: [PATCH] explorer: better blocs layout --- explorer/src/Button.elm | 218 +++++++++++++++++++++------------------ explorer/src/Story.elm | 48 +++++---- explorer/src/Tooling.elm | 196 +++++++++++++++++++++++++---------- 3 files changed, 284 insertions(+), 178 deletions(-) diff --git a/explorer/src/Button.elm b/explorer/src/Button.elm index d769c08..17b3842 100644 --- a/explorer/src/Button.elm +++ b/explorer/src/Button.elm @@ -18,16 +18,23 @@ import Widget.Material.Typography as Typography page = Tooling.firstBloc (intro |> Tooling.withBlocTitle "Button") |> Tooling.nextBlocList book + |> Tooling.nextBloc demo |> Tooling.page intro = - Tooling.markdown + Tooling.markdown [] """ A simple button """ book = - Story.book (Just "States") buttonBlocs + Story.book (Just "States") + (Story.initStaticBlocs + |> Story.addBloc Tooling.LeftColumnBloc + [ Background.color <| MaterialColor.fromColor MaterialColor.gray ] + Nothing + viewButton + ) |> Story.addStory (Story.optionListStory "Palette" defaultPalette @@ -52,7 +59,7 @@ book = ) |> Story.addStory (Story.boolStory "with event handler" - ( Just Noop, Nothing ) + ( Just (), Nothing ) True ) |> Story.addStory @@ -66,6 +73,21 @@ book = |> Story.build +viewButton palette text icon onPress size _ _ = + Widget.button + (containedButton palette + |> Customize.elementButton + [ Element.height <| Element.px size + , Element.centerX + , Element.centerY + ] + ) + { text = text + , icon = icon + , onPress = onPress + } + + type alias Model = Int @@ -77,20 +99,19 @@ type Msg | Noop -buttonBlocs = - Story.initBlocs - { init = always init - , update = update - , subscriptions = subscriptions - } - |> Story.addBloc Nothing viewButton - |> Story.addBloc (Just "Interactive example") view - - --|> Story.addBloc (Just "Interactive example") view +demo = + { init = always init + , update = update + , title = Just "Interactive Demo" + , view = view + , subscriptions = subscriptions + } + + init : ( Model, Cmd Msg ) init = ( 0, Cmd.none ) @@ -127,20 +148,11 @@ subscriptions _ = Sub.none -viewButton palette text icon onPress size _ _ = - Tooling.canvas <| - Widget.button - (containedButton palette - |> Customize.elementButton [ Element.height <| Element.px size ] - ) - { text = text - , icon = icon - , onPress = onPress - } - - -view palette _ _ _ _ _ model = +view _ model = let + palette = + Material.defaultPalette + style = { containedButton = Material.containedButton palette , outlinedButton = Material.outlinedButton palette @@ -151,83 +163,87 @@ view palette _ _ _ _ _ model = , cardColumn = Material.cardColumn palette } in - [ model - |> String.fromInt - |> Element.text - |> Element.el - (Typography.h4 - ++ [ Element.centerX, Element.centerY ] - ) - |> List.singleton - |> Widget.column - (style.cardColumn - |> Customize.elementColumn - [ Element.centerX - , Element.width <| Element.px 128 - , Element.height <| Element.px 128 - , Widget.iconButton style.iconButton - { text = "+2" - , icon = - MaterialIcons.exposure_plus_2 - |> Icon.elmMaterialIcons Color - , onPress = - Increase 2 - |> Just - } - |> Element.el [ Element.alignRight ] - |> Element.inFront - ] - |> Customize.mapContent - (Customize.element - [ Element.width <| Element.px 128 + { position = Tooling.FullWidthBloc + , attributes = [] + , body = + [ model + |> String.fromInt + |> Element.text + |> Element.el + (Typography.h4 + ++ [ Element.centerX, Element.centerY ] + ) + |> List.singleton + |> Widget.column + (style.cardColumn + |> Customize.elementColumn + [ Element.centerX + , Element.width <| Element.px 128 , Element.height <| Element.px 128 - , Material.defaultPalette.secondary - |> MaterialColor.fromColor - |> Background.color + , Widget.iconButton style.iconButton + { text = "+2" + , icon = + MaterialIcons.exposure_plus_2 + |> Icon.elmMaterialIcons Color + , onPress = + Increase 2 + |> Just + } + |> Element.el [ Element.alignRight ] + |> Element.inFront ] - ) - ) - , [ [ Widget.textButton style.textButton - { text = "Reset" - , onPress = - Reset - |> Just - } - , Widget.button style.outlinedButton - { text = "Decrease" - , icon = - MaterialIcons.remove - |> Icon.elmMaterialIcons Color - , onPress = - if model > 0 then - Decrease 1 + |> Customize.mapContent + (Customize.element + [ Element.width <| Element.px 128 + , Element.height <| Element.px 128 + , Material.defaultPalette.secondary + |> MaterialColor.fromColor + |> Background.color + ] + ) + ) + , [ [ Widget.textButton style.textButton + { text = "Reset" + , onPress = + Reset |> Just + } + , Widget.button style.outlinedButton + { text = "Decrease" + , icon = + MaterialIcons.remove + |> Icon.elmMaterialIcons Color + , onPress = + if model > 0 then + Decrease 1 + |> Just - else - Nothing - } + else + Nothing + } + ] + |> Widget.row (style.row |> Customize.elementRow [ Element.alignRight ]) + , [ Widget.button style.containedButton + { text = "Increase" + , icon = + MaterialIcons.add + |> Icon.elmMaterialIcons Color + , onPress = + Increase 1 + |> Just + } + ] + |> Widget.row (style.row |> Customize.elementRow [ Element.alignLeft ]) + ] + |> Widget.row + (style.row + |> Customize.elementRow [ Element.width <| Element.fill ] + |> Customize.mapContent (Customize.element [ Element.width <| Element.fill ]) + ) ] - |> Widget.row (style.row |> Customize.elementRow [ Element.alignRight ]) - , [ Widget.button style.containedButton - { text = "Increase" - , icon = - MaterialIcons.add - |> Icon.elmMaterialIcons Color - , onPress = - Increase 1 - |> Just - } - ] - |> Widget.row (style.row |> Customize.elementRow [ Element.alignLeft ]) - ] - |> Widget.row - (style.row - |> Customize.elementRow [ Element.width <| Element.fill ] - |> Customize.mapContent (Customize.element [ Element.width <| Element.fill ]) - ) - ] - |> Widget.column - (style.column - |> Customize.elementColumn [ Element.width <| Element.fill ] - |> Customize.mapContent (Customize.element [ Element.width <| Element.fill ]) - ) + |> Widget.column + (style.column + |> Customize.elementColumn [ Element.width <| Element.fill ] + |> Customize.mapContent (Customize.element [ Element.width <| Element.fill ]) + ) + } diff --git a/explorer/src/Story.elm b/explorer/src/Story.elm index 539a664..6f69d6d 100644 --- a/explorer/src/Story.elm +++ b/explorer/src/Story.elm @@ -1,7 +1,7 @@ module Story exposing (..) import Dict exposing (Dict) -import Element exposing (Element) +import Element exposing (Attribute, Element) import Element.Input as Input exposing (Label, Option, labelAbove, option, radio) import SelectList exposing (SelectList) import Tooling @@ -78,7 +78,7 @@ type alias BlocList view model msg flags = { init : flags -> ( model, Cmd msg ) , update : msg -> model -> ( model, Cmd msg ) , titles : List (Maybe String) - , views : List view + , views : List ( Tooling.BlocPosition, List (Attribute msg), view ) , subscriptions : model -> Sub msg } @@ -87,7 +87,7 @@ type alias BlocListBuilder view model msg flags a = { init : flags -> ( model, Cmd msg ) , update : msg -> model -> ( model, Cmd msg ) , titles : List (Maybe String) - , views : a -> List view + , views : a -> List ( Tooling.BlocPosition, List (Attribute msg), view ) , subscriptions : model -> Sub msg } @@ -146,17 +146,7 @@ addStoryToBlocList builder = , views = \( a, previous ) -> builder.views previous - |> List.map (\view -> view a) - } - - -static : view -> BlocList view flags msg flags -static blocView = - { init = \flags -> ( flags, Cmd.none ) - , titles = [ Nothing ] - , update = \_ m -> ( m, Cmd.none ) - , views = [ blocView ] - , subscriptions = \_ -> Sub.none + |> List.map (\( position, attrs, view ) -> ( position, attrs, view a )) } @@ -175,11 +165,27 @@ initBlocs { init, update, subscriptions } = } -addBloc : Maybe String -> view -> BlocList view model msg flags -> BlocList view model msg flags -addBloc title view bloclist = +addBloc : + Tooling.BlocPosition + -> List (Attribute msg) + -> Maybe String + -> view + -> BlocList view model msg flags + -> BlocList view model msg flags +addBloc position attributes title view bloclist = { bloclist | titles = List.append bloclist.titles [ title ] - , views = List.append bloclist.views [ view ] + , views = List.append bloclist.views [ ( position, attributes, view ) ] + } + + +initStaticBlocs : BlocList view () () () +initStaticBlocs = + { init = always ( (), Cmd.none ) + , titles = [] + , update = \_ _ -> ( (), Cmd.none ) + , views = [] + , subscriptions = always Sub.none } @@ -384,7 +390,8 @@ storyBloc title stories storiesToValue = , subscriptions = always Sub.none , views = \_ model -> - [ { sidebloc = True + [ { position = Tooling.NewRightColumnBloc + , attributes = [] , body = model |> List.map storyView @@ -409,8 +416,9 @@ build builder = , views = \pagesize ( selectorModel, model ) -> List.map - (\view -> - { sidebloc = False + (\( position, attrs, view ) -> + { position = position + , attributes = attrs , body = view pagesize model } ) diff --git a/explorer/src/Tooling.elm b/explorer/src/Tooling.elm index 1aebc56..f61f67f 100644 --- a/explorer/src/Tooling.elm +++ b/explorer/src/Tooling.elm @@ -1,25 +1,38 @@ module Tooling exposing (..) import Dict exposing (Dict) -import Element exposing (Element) +import Element exposing (Attribute, Element) +import Element.Background as Background import Markdown import SelectList exposing (SelectList) import UiExplorer exposing (Page, PageSize) import Widget +import Widget.Customize as Customize import Widget.Material as Material +import Widget.Material.Color as MaterialColor import Widget.Material.Typography as Typography +type BlocPosition + = FullWidthBloc + | RightColumnBloc + | NewRightColumnBloc + | LeftColumnBloc + | NewLeftColumnBloc + + type alias BlocView msg = { body : Element msg - , sidebloc : Bool + , position : BlocPosition + , attributes : List (Attribute msg) } mapBlocView : (a -> b) -> BlocView a -> BlocView b mapBlocView map view = { body = Element.map map view.body - , sidebloc = view.sidebloc + , position = view.position + , attributes = List.map (Element.mapAttribute map) view.attributes } @@ -129,6 +142,10 @@ blocListSingleton bloc = } +type alias BlocMeta = + { title : Maybe String } + + {-| -} type BlocBuilder model msg flags = BlocBuilder @@ -136,7 +153,7 @@ type BlocBuilder model msg flags , update : msg -> model -> ( model, Cmd msg ) , views : PageSize -> model -> List (BlocView msg) , subscriptions : model -> Sub msg - , meta : List { title : Maybe String } + , meta : List BlocMeta } @@ -228,70 +245,147 @@ nextBlocList config (BlocBuilder previous) = } +type LayoutRow msg + = OneColumn (List ( BlocMeta, BlocView msg )) + | TwoColumn (List ( BlocMeta, BlocView msg )) (List ( BlocMeta, BlocView msg )) + + +type alias Layout msg = + List (LayoutRow msg) + + +layoutAddBloc : ( BlocMeta, BlocView msg ) -> Layout msg -> Layout msg +layoutAddBloc ( meta, view ) layout = + case view.position of + FullWidthBloc -> + case layout of + (OneColumn items) :: tail -> + OneColumn (( meta, view ) :: items) :: tail + + _ -> + OneColumn [ ( meta, view ) ] :: layout + + LeftColumnBloc -> + case layout of + (TwoColumn left right) :: tail -> + TwoColumn (( meta, view ) :: left) right :: tail + + _ -> + TwoColumn [ ( meta, view ) ] [] :: layout + + NewLeftColumnBloc -> + TwoColumn [ ( meta, view ) ] [] :: layout + + RightColumnBloc -> + case layout of + (TwoColumn left right) :: tail -> + TwoColumn left (( meta, view ) :: right) :: tail + + _ -> + TwoColumn [] [ ( meta, view ) ] :: layout + + NewRightColumnBloc -> + TwoColumn [] [ ( meta, view ) ] :: layout + + +layoutBlocView : List (Attribute msg) -> ( BlocMeta, BlocView msg ) -> Element msg +layoutBlocView attributes ( meta, view ) = + Widget.column + (Material.cardColumn Material.defaultPalette + |> Customize.elementColumn attributes + |> Customize.mapContent (Customize.element <| Element.height Element.fill :: view.attributes) + ) + <| + List.filterMap identity + [ meta.title + |> Maybe.map Element.text + |> Maybe.map (Element.el Typography.h3) + , Just view.body + ] + + +layoutRowView : LayoutRow msg -> List (Element msg) +layoutRowView row = + case row of + OneColumn items -> + items + |> List.reverse + |> List.map (layoutBlocView []) + + TwoColumn left right -> + Element.row + [ Element.width Element.fill + , Element.spacing 10 + ] + [ Element.column + [ Element.width <| Element.fillPortion 2 + , Element.height Element.fill + ] + <| + List.map + (layoutBlocView + [ Element.height Element.fill ] + ) + <| + List.reverse left + , Element.column + [ Element.width <| Element.fillPortion 1 + , Element.height Element.fill + ] + <| + List.map + (layoutBlocView + [ Element.height Element.fill ] + ) + <| + List.reverse right + ] + |> List.singleton + + page : BlocBuilder model msg flags -> Page model msg flags page (BlocBuilder config) = { init = config.init , update = config.update , view = \pagesize model -> - let - ( sideblocs, blocs ) = - config.views pagesize model - |> List.map2 - (\meta view -> - ( view.sidebloc - , Widget.column (Material.cardColumn Material.defaultPalette) <| - List.filterMap identity - [ meta.title - |> Maybe.map Element.text - |> Maybe.map (Element.el Typography.h3) - , Just view.body - ] - ) - ) - config.meta - |> List.partition Tuple.first - |> Tuple.mapBoth (List.map Tuple.second) (List.map Tuple.second) - in - Element.row - [ Element.width Element.shrink - , Element.centerX - , Element.spacing 10 - ] - [ Element.column + config.views pagesize model + |> List.map2 Tuple.pair config.meta + |> List.foldl layoutAddBloc [] + |> List.reverse + |> List.concatMap layoutRowView + |> Element.column [ Element.padding 10 , Element.spacing 10 , Element.px 800 |> Element.width + , Element.centerX ] - blocs - , Element.column - [ Element.padding 10 - , Element.spacing 10 - , Element.px 400 |> Element.width - ] - sideblocs - ] , subscriptions = config.subscriptions } {-| render a markdown text into a simple panel -} -markdown : String -> Bloc () () () -markdown text = - static +markdown : List (Attribute ()) -> String -> Bloc () () () +markdown attributes text = + static attributes (\_ _ -> Markdown.toHtml [] text |> Element.html ) -static : (PageSize -> flags -> Element msg) -> Bloc flags msg flags -static blocView = +static : List (Attribute msg) -> (PageSize -> flags -> Element msg) -> Bloc flags msg flags +static attributes blocView = { init = \flags -> ( flags, Cmd.none ) , title = Nothing , update = \_ m -> ( m, Cmd.none ) - , view = \pagesize flags -> { body = blocView pagesize flags, sidebloc = False } + , view = + \pagesize flags -> + { body = blocView pagesize flags + , position = FullWidthBloc + , attributes = attributes + } , subscriptions = \_ -> Sub.none } @@ -306,23 +400,11 @@ canvas view = Element.el [ Element.padding 30 , Element.width Element.fill + , Background.color <| MaterialColor.fromColor <| MaterialColor.gray ] <| Element.el [ Element.centerX - , Element.width Element.shrink + , Element.centerY ] view - - -assidebloc : Bloc model msg flags -> Bloc model msg flags -assidebloc bloc = - { bloc - | view = - \pagesize model -> - let - sidebloc = - bloc.view pagesize model - in - { sidebloc | sidebloc = True } - }