explorer: better stories

Improved the Story module to support arbitrary inputs and various input widgets
This commit is contained in:
Christophe de Vienne 2021-05-21 13:23:30 +02:00
parent 260429be75
commit 8c96747329
2 changed files with 318 additions and 116 deletions

View File

@ -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

View File

@ -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
}
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
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
)
}