diff --git a/explorer/src/Button.elm b/explorer/src/Button.elm index fa0d6a6..d769c08 100644 --- a/explorer/src/Button.elm +++ b/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" - [ ( "OK", "OK" ) - , ( "Cancel", "Cancel" ) - , ( "Something a little too long", "Something a little too long" ) - ] + (Story.textStory "Label" + "OK" ) |> 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" - [ ( "Something", Just Noop ) - , ( "Nothing", Nothing ) - ] + (Story.boolStory "with event handler" + ( Just Noop, 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 diff --git a/explorer/src/Story.elm b/explorer/src/Story.elm index 267e198..539a664 100644 --- a/explorer/src/Story.elm +++ b/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 - , options : List ( String, a ) + { info : StoryInfo + , 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 ) - , bloclist : BlocList view model msg flags + , stories : List StoryInfo + , 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 - } - - -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 + , storiesToValue = always () , bloclist = - builder.bloclist - |> addStoryToBlocList story + { init = bloclist.init + , update = bloclist.update + , titles = bloclist.titles + , subscriptions = bloclist.subscriptions + , views = always bloclist.views + } } -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 +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 = - List.map - (List.concatMap - (\( id, view ) -> - List.map - (\( name, a ) -> - ( name :: id, view a ) - ) - story.options - ) - ) - bloclist.views - , subscriptions = bloclist.subscriptions + \( 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 -selectedStory = +enforceRange : Int -> Int -> Int -> Int +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) - >> String.join "/" + storyCurrentValue selectStory : String -> String -> StorySelectorModel -> StorySelectorModel -selectStory story value = +selectStory label value = List.map - (\( label, options ) -> - if label == story then - ( label - , options - |> SelectList.attempt (SelectList.selectBeforeIf <| (==) value) - |> SelectList.attempt (SelectList.selectAfterIf <| (==) value) - ) + (\story -> + if storyLabelIs label story then + storySetValue value story else - ( label, options ) + story ) @@ -143,14 +295,79 @@ type StorySelectorMsg = StorySelect String String -storyHelp : ( String, List String ) -> Maybe ( String, SelectList String ) -storyHelp ( label, options ) = - SelectList.fromList options - |> Maybe.map (Tuple.pair label) +storyHelp : StoryInfo -> Maybe StoryModel +storyHelp info = + case info of + 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 -storyBloc title stories = +storyView : StoryModel -> Element StorySelectorMsg +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 - (\( 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 - } - ) + |> List.map storyView |> 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 - 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 + storyBloc builder.title builder.stories builder.storiesToValue |> Tooling.linkBlocList { init = builder.bloclist.init , update = @@ -218,15 +409,15 @@ build builder = , views = \pagesize ( selectorModel, model ) -> List.map - (\viewsDict -> + (\view -> { sidebloc = False - , body = - (Dict.get (selectedStory selectorModel) viewsDict - |> Maybe.withDefault (\_ _ -> Element.none) - ) - pagesize - model + , body = view pagesize model } ) - views + (selectorModel + |> selectedStories + |> List.reverse + |> builder.storiesToValue + |> builder.bloclist.views + ) }