explorer: better blocs layout

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 _ _ =
+view _ model =
-    Tooling.canvas <|
-        Widget.button
-            (containedButton palette
-                |> Customize.elementButton [ Element.height <| Element.px size ]
-            )
-            { text = text
-            , icon = icon
-            , onPress = onPress
-            }
-
-
-view palette _ _ _ _ _ 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
+    { position = Tooling.FullWidthBloc
-        |> String.fromInt
+    , attributes = []
-        |> Element.text
+    , body =
-        |> Element.el
+        [ model
-            (Typography.h4
+            |> String.fromInt
-                ++ [ Element.centerX, Element.centerY ]
+            |> Element.text
-            )
+            |> Element.el
-        |> List.singleton
+                (Typography.h4
-        |> Widget.column
+                    ++ [ Element.centerX, Element.centerY ]
-            (style.cardColumn
+                )
-                |> Customize.elementColumn
+            |> List.singleton
-                    [ Element.centerX
+            |> Widget.column
-                    , Element.width <| Element.px 128
+                (style.cardColumn
-                    , Element.height <| Element.px 128
+                    |> Customize.elementColumn
-                    , Widget.iconButton style.iconButton
+                        [ Element.centerX
-                        { text = "+2"
+                        , Element.width <| Element.px 128
-                        , 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
                         , Element.height <| Element.px 128
-                        , Material.defaultPalette.secondary
+                        , Widget.iconButton style.iconButton
-                            |> MaterialColor.fromColor
+                            { text = "+2"
-                            |> Background.color
+                            , icon =
+                                MaterialIcons.exposure_plus_2
+                                    |> Icon.elmMaterialIcons Color
+                            , onPress =
+                                Increase 2
+                                    |> Just
+                            }
+                            |> Element.el [ Element.alignRight ]
+                            |> Element.inFront
                         ]
-                    )
+                    |> Customize.mapContent
-            )
+                        (Customize.element
-    , [ [ Widget.textButton style.textButton
+                            [ Element.width <| Element.px 128
-            { text = "Reset"
+                            , Element.height <| Element.px 128
-            , onPress =
+                            , Material.defaultPalette.secondary
-                Reset
+                                |> MaterialColor.fromColor
-                    |> Just
+                                |> Background.color
-            }
+                            ]
-        , Widget.button style.outlinedButton
+                        )
-            { text = "Decrease"
+                )
-            , icon =
+        , [ [ Widget.textButton style.textButton
-                MaterialIcons.remove
+                { text = "Reset"
-                    |> Icon.elmMaterialIcons Color
+                , onPress =
-            , onPress =
+                    Reset
-                if model > 0 then
-                    Decrease 1
                         |> Just
+                }
+            , Widget.button style.outlinedButton
+                { text = "Decrease"
+                , icon =
+                    MaterialIcons.remove
+                        |> Icon.elmMaterialIcons Color
+                , onPress =
+                    if model > 0 then
+                        Decrease 1
+                            |> Just
 
-                else
+                    else
-                    Nothing
+                        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.column
-      , [ Widget.button style.containedButton
+                (style.column
-            { text = "Increase"
+                    |> Customize.elementColumn [ Element.width <| Element.fill ]
-            , icon =
+                    |> Customize.mapContent (Customize.element [ Element.width <| Element.fill ])
-                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 ])
-            )

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)
+                |> List.map (\( position, attrs, view ) -> ( position, attrs, 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
     }
 
 
@@ -175,11 +165,27 @@ initBlocs { init, update, subscriptions } =
     }
 
 
-addBloc : Maybe String -> view -> BlocList view model msg flags -> BlocList view model msg flags
+addBloc :
-addBloc title view bloclist =
+    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 ->
+                        (\( position, attrs, view ) ->
-                            { sidebloc = False
+                            { position = position
+                            , attributes = attrs
                             , body = view pagesize model
                             }
                         )

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
+            config.views pagesize model
-                ( sideblocs, blocs ) =
+                |> List.map2 Tuple.pair config.meta
-                    config.views pagesize model
+                |> List.foldl layoutAddBloc []
-                        |> List.map2
+                |> List.reverse
-                            (\meta view ->
+                |> List.concatMap layoutRowView
-                                ( view.sidebloc
+                |> Element.column
-                                , 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
                     [ 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 : List (Attribute ()) -> String -> Bloc () () ()
-markdown text =
+markdown attributes text =
-    static
+    static attributes
         (\_ _ ->
             Markdown.toHtml [] text
                 |> Element.html
         )
 
 
-static : (PageSize -> flags -> Element msg) -> Bloc flags msg flags
+static : List (Attribute msg) -> (PageSize -> flags -> Element msg) -> Bloc flags msg flags
-static blocView =
+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 }
-    }