explorer: better stories

Improved the Story module to support arbitrary inputs and various input widgets

explorer/src/Button.elm

@@ -4,7 +4,7 @@ import Element exposing (Element)
 import Element.Background as Background
 import Material.Icons as MaterialIcons exposing (offline_bolt)
 import Material.Icons.Types exposing (Coloring(..))
-import Story exposing (Story)
+import Story
 import Tooling
 import UiExplorer
 import Widget
@@ -29,20 +29,21 @@ intro =
 book =
     Story.book (Just "States") buttonBlocs
         |> Story.addStory
-            (Story "Palette"
+            (Story.optionListStory "Palette"
+                defaultPalette
                 [ ( "default", defaultPalette )
                 , ( "dark", darkPalette )
                 ]
             )
         |> Story.addStory
-            (Story "Text"
+            (Story.textStory "Label"
-                [ ( "OK", "OK" )
+                "OK"
-                , ( "Cancel", "Cancel" )
-                , ( "Something a little too long", "Something a little too long" )
-                ]
             )
         |> Story.addStory
-            (Story "Icon"
+            (Story.optionListStory "Icon"
+                (MaterialIcons.done
+                    |> Icon.elmMaterialIcons Color
+                )
                 [ ( "done"
                   , MaterialIcons.done
                         |> Icon.elmMaterialIcons Color
@@ -50,10 +51,17 @@ book =
                 ]
             )
         |> Story.addStory
-            (Story "onPress"
+            (Story.boolStory "with event handler"
-                [ ( "Something", Just Noop )
+                ( Just Noop, Nothing )
-                , ( "Nothing", Nothing )
+                True
-                ]
+            )
+        |> Story.addStory
+            (Story.rangeStory "Height"
+                { unit = "px"
+                , min = 1
+                , max = 200
+                , default = 48
+                }
             )
         |> Story.build
 
@@ -119,16 +127,19 @@ subscriptions _ =
     Sub.none
 
 
-viewButton palette text icon onPress _ _ =
+viewButton palette text icon onPress size _ _ =
     Tooling.canvas <|
-        Widget.button (containedButton palette)
+        Widget.button
+            (containedButton palette
+                |> Customize.elementButton [ Element.height <| Element.px size ]
+            )
             { text = text
             , icon = icon
             , onPress = onPress
             }
 
 
-view palette _ _ _ _ model =
+view palette _ _ _ _ _ model =
     let
         style =
             { containedButton = Material.containedButton palette

explorer/src/Story.elm

@@ -2,15 +2,75 @@ module Story exposing (..)
 
 import Dict exposing (Dict)
 import Element exposing (Element)
-import Element.Input exposing (Label, Option, labelAbove, option, radio)
+import Element.Input as Input exposing (Label, Option, labelAbove, option, radio)
 import SelectList exposing (SelectList)
 import Tooling
 import UiExplorer exposing (PageSize)
 
 
+type StoryInfo
+    = RangeStory String { unit : String, min : Int, max : Int, default : Int }
+    | TextStory String String
+    | OptionListStory String (List String)
+    | BoolStory String Bool
+
+
 type alias Story a =
-    { label : String
+    { info : StoryInfo
-    , options : List ( String, a )
+    , toValue : String -> a
+    }
+
+
+optionListStory : String -> a -> List ( String, a ) -> Story a
+optionListStory label default options =
+    { info = OptionListStory label <| List.map Tuple.first options
+    , toValue =
+        \optLabel ->
+            options
+                |> List.foldl
+                    (\( key, optvalue ) res ->
+                        case ( res, optLabel == key ) of
+                            ( Just x, _ ) ->
+                                Just x
+
+                            ( Nothing, True ) ->
+                                Just optvalue
+
+                            ( Nothing, False ) ->
+                                Nothing
+                    )
+                    Nothing
+                |> Maybe.withDefault default
+    }
+
+
+textStory : String -> String -> Story String
+textStory label default =
+    { info = TextStory label default
+    , toValue = identity
+    }
+
+
+rangeStory :
+    String
+    -> { unit : String, min : Int, max : Int, default : Int }
+    -> Story Int
+rangeStory label cfg =
+    { info = RangeStory label cfg
+    , toValue = String.toInt >> Maybe.withDefault cfg.default
+    }
+
+
+boolStory : String -> ( a, a ) -> Bool -> Story a
+boolStory label ( ifTrue, ifFalse ) default =
+    { info = BoolStory label default
+    , toValue =
+        \s ->
+            if s == "t" then
+                ifTrue
+
+            else
+                ifFalse
     }
 
 
@@ -18,64 +78,75 @@ type alias BlocList view model msg flags =
     { init : flags -> ( model, Cmd msg )
     , update : msg -> model -> ( model, Cmd msg )
     , titles : List (Maybe String)
-    , views : List (List ( List String, view ))
+    , views : List view
     , subscriptions : model -> Sub msg
     }
 
 
-type alias BookBuilder view model msg flags =
+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
+    , subscriptions : model -> Sub msg
+    }
+
+
+type alias BookBuilder view model msg flags a =
     { title : Maybe String
-    , stories : List ( String, List String )
+    , stories : List StoryInfo
-    , bloclist : BlocList view model msg flags
+    , storiesToValue : List String -> a
+    , bloclist : BlocListBuilder view model msg flags a
     }
 
 
 book :
     Maybe String
     -> BlocList view model msg flags
-    -> BookBuilder view model msg flags
+    -> BookBuilder view model msg flags ()
 book title bloclist =
     { title = title
     , stories = []
-    , bloclist = bloclist
+    , storiesToValue = always ()
-    }
-
-
-addStory : Story a -> BookBuilder (a -> view) model msg flags -> BookBuilder view model msg flags
-addStory story builder =
-    { title = builder.title
-    , stories =
-        ( story.label
-        , story.options |> List.map Tuple.first
-        )
-            :: builder.stories
     , bloclist =
-        builder.bloclist
-            |> addStoryToBlocList story
-    }
-
-
-addStoryToBlocList :
-    Story a
-    -> BlocList (a -> view) model msg flags
-    -> BlocList view model msg flags
-addStoryToBlocList story bloclist =
         { init = bloclist.init
         , update = bloclist.update
         , titles = bloclist.titles
-    , views =
-        List.map
-            (List.concatMap
-                (\( id, view ) ->
-                    List.map
-                        (\( name, a ) ->
-                            ( name :: id, view a )
-                        )
-                        story.options
-                )
-            )
-            bloclist.views
         , subscriptions = bloclist.subscriptions
+        , views = always bloclist.views
+        }
+    }
+
+
+addStory : Story a -> BookBuilder (a -> view) model msg flags previous -> BookBuilder view model msg flags ( a, previous )
+addStory { info, toValue } builder =
+    let
+        storiesToValue key =
+            -- consume the first token and delegate the rest to the former 'tovalue'
+            case key of
+                head :: tail ->
+                    ( toValue head, builder.storiesToValue tail )
+
+                [] ->
+                    ( toValue "", builder.storiesToValue [] )
+    in
+    { title = builder.title
+    , stories = info :: builder.stories
+    , storiesToValue = storiesToValue
+    , bloclist = addStoryToBlocList builder.bloclist
+    }
+
+
+addStoryToBlocList : BlocListBuilder (a -> view) model msg flags previous -> BlocListBuilder view model msg flags ( a, previous )
+addStoryToBlocList builder =
+    { init = builder.init
+    , update = builder.update
+    , titles = builder.titles
+    , subscriptions = builder.subscriptions
+    , views =
+        \( a, previous ) ->
+            builder.views previous
+                |> List.map (\view -> view a)
     }
 
 
@@ -84,7 +155,7 @@ static blocView =
     { init = \flags -> ( flags, Cmd.none )
     , titles = [ Nothing ]
     , update = \_ m -> ( m, Cmd.none )
-    , views = [ [ ( [], blocView ) ] ]
+    , views = [ blocView ]
     , subscriptions = \_ -> Sub.none
     }
 
@@ -108,34 +179,115 @@ addBloc : Maybe String -> view -> BlocList view model msg flags -> BlocList view
 addBloc title view bloclist =
     { bloclist
         | titles = List.append bloclist.titles [ title ]
-        , views = List.append bloclist.views [ [ ( [], view ) ] ]
+        , views = List.append bloclist.views [ view ]
     }
 
 
+type StoryModel
+    = RangeStoryModel String { unit : String, min : Int, max : Int, value : Int }
+    | TextStoryModel String String
+    | OptionListStoryModel String (SelectList String)
+    | BoolStoryModel String Bool
+
+
 type alias StorySelectorModel =
-    List ( String, SelectList String )
+    List StoryModel
 
 
-selectedStory : StorySelectorModel -> String
+enforceRange : Int -> Int -> Int -> Int
-selectedStory =
+enforceRange min max value =
+    case ( value < min, value > max ) of
+        ( True, True ) ->
+            value
+
+        ( True, False ) ->
+            min
+
+        ( False, True ) ->
+            max
+
+        ( False, False ) ->
+            value
+
+
+storyCurrentValue : StoryModel -> String
+storyCurrentValue model =
+    case model of
+        RangeStoryModel _ { value } ->
+            String.fromInt value
+
+        TextStoryModel _ value ->
+            value
+
+        OptionListStoryModel _ select ->
+            SelectList.selected select
+
+        BoolStoryModel _ value ->
+            if value then
+                "t"
+
+            else
+                "f"
+
+
+storyLabelIs : String -> StoryModel -> Bool
+storyLabelIs label model =
+    case model of
+        RangeStoryModel storyLabel _ ->
+            label == storyLabel
+
+        TextStoryModel storyLabel _ ->
+            label == storyLabel
+
+        OptionListStoryModel storyLabel _ ->
+            label == storyLabel
+
+        BoolStoryModel storyLabel _ ->
+            label == storyLabel
+
+
+storySetValue : String -> StoryModel -> StoryModel
+storySetValue value model =
+    case model of
+        RangeStoryModel storyLabel state ->
+            case String.toInt value of
+                Nothing ->
+                    model
+
+                Just intValue ->
+                    RangeStoryModel storyLabel
+                        { state
+                            | value = enforceRange state.min state.max intValue
+                        }
+
+        TextStoryModel storyLabel oldValue ->
+            TextStoryModel storyLabel value
+
+        OptionListStoryModel storyLabel select ->
+            select
+                |> SelectList.attempt (SelectList.selectBeforeIf <| (==) value)
+                |> SelectList.attempt (SelectList.selectAfterIf <| (==) value)
+                |> OptionListStoryModel storyLabel
+
+        BoolStoryModel storyLabel _ ->
+            BoolStoryModel storyLabel <| value == "t"
+
+
+selectedStories : StorySelectorModel -> List String
+selectedStories =
     List.map
-        (Tuple.second >> SelectList.selected)
+        storyCurrentValue
-        >> String.join "/"
 
 
 selectStory : String -> String -> StorySelectorModel -> StorySelectorModel
-selectStory story value =
+selectStory label value =
     List.map
-        (\( label, options ) ->
+        (\story ->
-            if label == story then
+            if storyLabelIs label story then
-                ( label
+                storySetValue value story
-                , options
-                    |> SelectList.attempt (SelectList.selectBeforeIf <| (==) value)
-                    |> SelectList.attempt (SelectList.selectAfterIf <| (==) value)
-                )
 
             else
-                ( label, options )
+                story
         )
 
 
@@ -143,14 +295,79 @@ type StorySelectorMsg
     = StorySelect String String
 
 
-storyHelp : ( String, List String ) -> Maybe ( String, SelectList String )
+storyHelp : StoryInfo -> Maybe StoryModel
-storyHelp ( label, options ) =
+storyHelp info =
-    SelectList.fromList options
+    case info of
-        |> Maybe.map (Tuple.pair label)
+        RangeStory label { unit, min, max, default } ->
+            Just <| RangeStoryModel label { unit = unit, min = min, max = max, value = default }
+
+        TextStory label default ->
+            Just <| TextStoryModel label default
+
+        OptionListStory label options ->
+            SelectList.fromList
+                options
+                |> Maybe.map (OptionListStoryModel label)
+
+        BoolStory label default ->
+            Just <| BoolStoryModel label default
 
 
-storyBloc : Maybe String -> List ( String, List String ) -> Tooling.BlocList StorySelectorModel StorySelectorMsg flags
+storyView : StoryModel -> Element StorySelectorMsg
-storyBloc title stories =
+storyView model =
+    case model of
+        RangeStoryModel label { unit, min, max, value } ->
+            Input.slider []
+                { onChange = round >> String.fromInt >> StorySelect label
+                , label = Input.labelAbove [] <| Element.text <| label ++ " (" ++ String.fromInt value ++ unit ++ ")"
+                , min = toFloat min
+                , max = toFloat max
+                , value = toFloat value
+                , thumb = Input.defaultThumb
+                , step = Just 1.0
+                }
+
+        TextStoryModel label value ->
+            Input.text []
+                { onChange = StorySelect label
+                , label = Input.labelAbove [] <| Element.text label
+                , placeholder = Nothing
+                , text = value
+                }
+
+        OptionListStoryModel label options ->
+            radio []
+                { label = labelAbove [] <| Element.text label
+                , onChange = StorySelect label
+                , options =
+                    options
+                        |> SelectList.toList
+                        |> List.map
+                            (\value ->
+                                option value <| Element.text value
+                            )
+                , selected = Just <| SelectList.selected options
+                }
+
+        BoolStoryModel label value ->
+            Input.checkbox []
+                { label = Input.labelRight [] <| Element.text label
+                , onChange =
+                    \v ->
+                        StorySelect label
+                            (if v then
+                                "t"
+
+                             else
+                                "f"
+                            )
+                , icon = Input.defaultCheckbox
+                , checked = value
+                }
+
+
+storyBloc : Maybe String -> List StoryInfo -> (List String -> a) -> Tooling.BlocList StorySelectorModel StorySelectorMsg flags
+storyBloc title stories storiesToValue =
     { init =
         \_ ->
             ( stories
@@ -170,21 +387,7 @@ storyBloc title stories =
             [ { sidebloc = True
               , body =
                     model
-                        |> List.map
+                        |> List.map storyView
-                            (\( label, options ) ->
-                                radio []
-                                    { label = labelAbove [] <| Element.text label
-                                    , onChange = StorySelect label
-                                    , options =
-                                        options
-                                            |> SelectList.toList
-                                            |> List.map
-                                                (\value ->
-                                                    option value <| Element.text value
-                                                )
-                                    , selected = Just <| SelectList.selected options
-                                    }
-                            )
                         |> Element.column []
               }
             ]
@@ -192,22 +395,10 @@ storyBloc title stories =
 
 
 build :
-    BookBuilder (PageSize -> model -> Element msg) model msg flags
+    BookBuilder (PageSize -> model -> Element msg) model msg flags a
     -> Tooling.BlocList ( StorySelectorModel, model ) (Tooling.BlocMsg StorySelectorMsg msg) flags
 build builder =
-    let
+    storyBloc builder.title builder.stories builder.storiesToValue
-        views : List (Dict String (PageSize -> model -> Element msg))
-        views =
-            builder.bloclist.views
-                |> List.map
-                    (List.map
-                        (\( id, view ) ->
-                            ( String.join "/" (id |> List.reverse), view )
-                        )
-                        >> Dict.fromList
-                    )
-    in
-    storyBloc builder.title builder.stories
         |> Tooling.linkBlocList
             { init = builder.bloclist.init
             , update =
@@ -218,15 +409,15 @@ build builder =
             , views =
                 \pagesize ( selectorModel, model ) ->
                     List.map
-                        (\viewsDict ->
+                        (\view ->
                             { sidebloc = False
-                            , body =
+                            , body = view pagesize model
-                                (Dict.get (selectedStory selectorModel) viewsDict
-                                    |> Maybe.withDefault (\_ _ -> Element.none)
-                                )
-                                    pagesize
-                                    model
                             }
                         )
-                        views
+                        (selectorModel
+                            |> selectedStories
+                            |> List.reverse
+                            |> builder.storiesToValue
+                            |> builder.bloclist.views
+                        )
             }