Merge pull request #59 from orus-io/ui-explorer

Added sketch of UIExplorer POC
This commit is contained in:
Orasund 2021-06-02 10:47:59 +02:00 committed by GitHub
commit ff0b02b656
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 3030 additions and 0 deletions

8
explorer/README.md Normal file
View File

@ -0,0 +1,8 @@
Explorer
========
To run the explorer :
```Bash
elm-live src/Main.elm
```

38
explorer/elm.json Normal file
View File

@ -0,0 +1,38 @@
{
"type": "application",
"source-directories": [
"src",
"../src"
],
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"avh4/elm-color": "1.0.0",
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
"elm/json": "1.1.3",
"elm/svg": "1.0.1",
"elm/url": "1.0.0",
"elm-explorations/markdown": "1.0.0",
"ianmackenzie/elm-units": "2.9.0",
"icidasset/elm-material-icons": "8.0.0",
"insurello/elm-ui-explorer": "2.0.0",
"mdgriffith/elm-ui": "1.1.7",
"miyamoen/select-list": "4.1.0",
"noahzgordon/elm-color-extra": "1.0.2",
"turboMaCk/queue": "1.1.0",
"zwilias/elm-rosetree": "1.5.0"
},
"indirect": {
"elm/regex": "1.0.0",
"elm/time": "1.0.0",
"elm/virtual-dom": "1.0.2",
"fredcy/elm-parseint": "2.0.1"
}
},
"test-dependencies": {
"direct": {},
"indirect": {}
}
}

21
explorer/src/Main.elm Normal file
View File

@ -0,0 +1,21 @@
module Main exposing (main)
import Element
import Pages.Button
import UIExplorer
pages =
UIExplorer.firstPage "Button" Pages.Button.page
main =
let
config =
UIExplorer.defaultConfig
in
UIExplorer.application
{ config
| sidebarTitle = Element.text "Elm UI Widgets"
}
pages

View File

@ -0,0 +1,399 @@
module Pages.Button exposing (page)
import Element exposing (Element)
import Element.Background as Background
import Element.Font
import Material.Icons as MaterialIcons exposing (offline_bolt)
import Material.Icons.Types exposing (Coloring(..))
import UIExplorer
import UIExplorer.Story as Story
import UIExplorer.Tile as Tile
import Widget
import Widget.Customize as Customize
import Widget.Icon as Icon exposing (Icon)
import Widget.Material as Material
exposing
( Palette
, containedButton
, darkPalette
, defaultPalette
, outlinedButton
, textButton
)
import Widget.Material.Color as MaterialColor
import Widget.Material.Typography as Typography
page =
Tile.first (intro |> Tile.withTitle "Button")
|> Tile.nextGroup book
|> Tile.next demo
|> Tile.page
intro =
Tile.markdown []
""" A simple button """
book =
Story.book (Just "options")
(Story.initStaticTiles
|> Story.addTile viewButton
|> Story.addTile viewTextButton
|> Story.addTile viewIconButton
|> Story.addTile viewSelectButton
--|> Story.addTile viewButtonSource
)
|> Story.addStory
(Story.optionListStory "Palette"
darkPalette
[ ( "dark", darkPalette )
, ( "default", defaultPalette )
]
)
|> Story.addStory
(Story.optionListStory "Material button"
containedButton
[ ( "contained", containedButton )
, ( "outlined", outlinedButton )
, ( "text", textButton )
]
)
|> Story.addStory
(Story.textStory "Label"
"OK"
)
|> Story.addStory
(Story.optionListStory "Icon"
(MaterialIcons.done
|> Icon.elmMaterialIcons Color
)
[ ( "done"
, MaterialIcons.done
|> Icon.elmMaterialIcons Color
)
]
)
|> Story.addStory
(Story.boolStory "with event handler"
( Just (), Nothing )
True
)
|> Story.build
viewLabel : String -> Element msg
viewLabel =
Element.el [ Element.width <| Element.px 250 ] << Element.text
viewButton palette button text icon onPress _ _ =
{ title = Nothing
, position = Tile.LeftColumnTile
, attributes = [ Background.color <| MaterialColor.fromColor palette.surface ]
, body =
Element.row
[ Element.width Element.fill
, Element.centerY
, Element.Font.color <| MaterialColor.fromColor palette.on.surface
]
[ viewLabel "button"
, Widget.button
(button palette
|> Customize.elementButton
[ Element.alignLeft
, Element.centerY
]
)
{ text = text
, icon = icon
, onPress = onPress
}
]
}
viewTextButton palette button text icon onPress _ _ =
{ title = Nothing
, position = Tile.LeftColumnTile
, attributes = [ Background.color <| MaterialColor.fromColor palette.surface ]
, body =
Element.row
[ Element.width Element.fill
, Element.centerY
, Element.Font.color <| MaterialColor.fromColor palette.on.surface
]
[ viewLabel "textButton"
, Widget.textButton
(button palette
|> Customize.elementButton
[ Element.alignLeft
, Element.centerY
]
)
{ text = text
, onPress = onPress
}
]
}
viewIconButton palette button text icon onPress _ _ =
{ title = Nothing
, position = Tile.LeftColumnTile
, attributes = [ Background.color <| MaterialColor.fromColor palette.surface ]
, body =
Element.row
[ Element.width Element.fill
, Element.centerY
, Element.Font.color <| MaterialColor.fromColor palette.on.surface
]
[ viewLabel "textButton"
, Widget.iconButton
(button palette
|> Customize.elementButton
[ Element.alignLeft
, Element.centerY
]
)
{ text = text
, icon = icon
, onPress = onPress
}
]
}
viewSelectButton palette button text icon onPress _ _ =
{ title = Nothing
, position = Tile.LeftColumnTile
, attributes = [ Background.color <| MaterialColor.fromColor palette.surface ]
, body =
Element.row
[ Element.width Element.fill
, Element.centerY
, Element.Font.color <| MaterialColor.fromColor palette.on.surface
]
[ viewLabel "select button"
, Element.column [ Element.width Element.fill, Element.spacing 8 ]
[ Widget.selectButton
(button palette
|> Customize.elementButton
[ Element.centerY
, Element.alignLeft
]
)
( False
, { text = text
, icon = icon
, onPress = onPress
}
)
, Widget.selectButton
(button palette
|> Customize.elementButton
[ Element.centerY
, Element.alignLeft
]
)
( True
, { text = text
, icon = icon
, onPress = onPress
}
)
]
]
}
viewButtonSource palette text icon onPress size _ _ =
{ title = Just "source code"
, position = Tile.FullWidthTile
, attributes = []
, body =
Tile.sourceCode <|
"""Widget.button
(Material.containedButton palette
|> Customize.elementButton [ Element.height <| Element.px """
++ String.fromInt size
++ """ ]
)
{ text =\""""
++ text
++ """"
, icon = MaterialIcons.done |> Icon.elmMaterialIcons Widget.Material.Types.Color
, onPress = """
++ (case onPress of
Nothing ->
"Nothing"
Just () ->
"Just ()"
)
++ """
}
"""
}
type alias Model =
Int
type Msg
= Increase Int
| Decrease Int
| Reset
| Noop
--|> Story.addTile (Just "Interactive example") view
demo =
{ init = always init
, update = update
, view = view
, subscriptions = subscriptions
}
init : ( Model, Cmd Msg )
init =
( 0, Cmd.none )
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Noop ->
( model, Cmd.none )
Increase int ->
( model + int
, Cmd.none
)
Decrease int ->
( if (model - int) >= 0 then
model - int
else
model
, Cmd.none
)
Reset ->
( 0
, Cmd.none
)
subscriptions : Model -> Sub Msg
subscriptions _ =
Sub.none
view _ model =
let
palette =
Material.defaultPalette
style =
{ containedButton = Material.containedButton palette
, outlinedButton = Material.outlinedButton palette
, textButton = Material.textButton palette
, iconButton = Material.iconButton palette
, row = Material.row
, column = Material.column
, cardColumn = Material.cardColumn palette
}
in
{ title = Just "Interactive Demo"
, position = Tile.FullWidthTile
, 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
, 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
, 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
}
]
|> 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 ])
)
}

35
explorer/src/Theme.elm Normal file
View File

@ -0,0 +1,35 @@
module Theme exposing (..)
import Widget.Material exposing (Palette)
type Theme
= MaterialDefault
| MaterialDark
allThemeOptions : List Theme
allThemeOptions =
[ MaterialDefault
, MaterialDark
]
themeOptionToString : Theme -> String
themeOptionToString theme =
case theme of
MaterialDefault ->
"Material"
MaterialDark ->
"Material dark"
themeValue : Theme -> Palette
themeValue theme =
case theme of
MaterialDefault ->
Widget.Material.defaultPalette
MaterialDark ->
Widget.Material.darkPalette

1649
explorer/src/UIExplorer.elm Normal file

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,445 @@
module UIExplorer.Story exposing (..)
import Dict exposing (Dict)
import Element exposing (Attribute, Element)
import Element.Input as Input exposing (Label, Option, labelAbove, option, radio)
import SelectList exposing (SelectList)
import UIExplorer.Tile as Tile exposing (Context)
import Widget
import Widget.Material as Material
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 =
{ 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
}
type alias Group view model msg flags =
{ init : flags -> ( model, Cmd msg )
, update : msg -> model -> ( model, Cmd msg )
, views : List view
, subscriptions : model -> Sub msg
}
type alias GroupBuilder view model msg flags a =
{ init : flags -> ( model, Cmd msg )
, update : msg -> model -> ( model, Cmd msg )
, views : a -> List view
, subscriptions : model -> Sub msg
}
type alias BookBuilder view model msg flags a =
{ title : Maybe String
, stories : List StoryInfo
, storiesToValue : List String -> a
, tilelist : GroupBuilder view model msg flags a
}
book :
Maybe String
-> Group view model msg flags
-> BookBuilder view model msg flags ()
book title tilelist =
{ title = title
, stories = []
, storiesToValue = always ()
, tilelist =
{ init = tilelist.init
, update = tilelist.update
, subscriptions = tilelist.subscriptions
, views = always tilelist.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
, tilelist = addStoryToGroup builder.tilelist
}
addStoryToGroup : GroupBuilder (a -> view) model msg flags previous -> GroupBuilder view model msg flags ( a, previous )
addStoryToGroup builder =
{ init = builder.init
, update = builder.update
, subscriptions = builder.subscriptions
, views =
\( a, previous ) ->
builder.views previous
|> List.map
(\view ->
view a
)
}
initTiles :
{ init : flags -> ( model, Cmd msg )
, update : msg -> model -> ( model, Cmd msg )
, subscriptions : model -> Sub msg
}
-> Group view model msg flags
initTiles { init, update, subscriptions } =
{ init = init
, update = update
, views = []
, subscriptions = subscriptions
}
addTile :
view
-> Group view model msg flags
-> Group view model msg flags
addTile view tilelist =
{ tilelist
| views =
List.append tilelist.views [ view ]
}
initStaticTiles : Group view () () ()
initStaticTiles =
{ init = always ( (), Cmd.none )
, update = \_ _ -> ( (), Cmd.none )
, views = []
, subscriptions = always Sub.none
}
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 StoryModel
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
storyCurrentValue
selectStory : String -> String -> StorySelectorModel -> StorySelectorModel
selectStory label value =
List.map
(\story ->
if storyLabelIs label story then
storySetValue value story
else
story
)
type StorySelectorMsg
= StorySelect String String
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
storyView : Context -> StoryModel -> Element StorySelectorMsg
storyView context model =
case model of
RangeStoryModel label { unit, min, max, value } ->
Element.column [ Element.spacing 8 ]
[ Element.text <| label ++ " (" ++ String.fromInt value ++ unit ++ ")"
, Input.slider []
{ onChange = round >> String.fromInt >> StorySelect label
, label = Input.labelHidden label
, min = toFloat min
, max = toFloat max
, value = toFloat value
, thumb = Input.defaultThumb
, step = Just 1.0
}
]
TextStoryModel label value ->
Element.column [ Element.spacing 8 ]
[ Element.text label
, Widget.textInput (Material.textInput context.palette)
{ chips = []
, onChange = StorySelect label
, label = label
, placeholder = Nothing
, text = value
}
]
OptionListStoryModel label options ->
Element.column [ Element.spacing 8 ]
[ Element.text label
, { selected =
Just <| SelectList.index options
, options =
options
|> SelectList.toList
|> List.map
(\opt ->
{ text = opt
, icon = always Element.none
}
)
, onSelect =
\selected ->
options
|> SelectList.toList
|> List.indexedMap (\i opt -> ( i, opt ))
|> List.filter (\( i, opt ) -> selected == i)
|> List.head
|> Maybe.map (Tuple.second >> StorySelect label)
}
|> Widget.select
|> Widget.buttonColumn
{ elementColumn = Material.column
, content = Material.textButton context.palette
}
]
BoolStoryModel label value ->
Element.row [ Element.spacing 8 ]
[ Widget.switch (Material.switch context.palette)
{ description = label
, onPress =
Just <|
StorySelect label <|
if value then
"f"
else
"t"
, active = value
}
, Element.text label
]
storyTile : Maybe String -> List StoryInfo -> (List String -> a) -> Tile.Group StorySelectorModel StorySelectorMsg flags
storyTile title stories storiesToValue =
{ init =
\_ ->
( stories
|> List.reverse
|> List.filterMap storyHelp
, Cmd.none
)
, update =
\msg model ->
case msg of
StorySelect story value ->
( selectStory story value model, Cmd.none )
, subscriptions = always Sub.none
, views =
\context model ->
[ { title = title
, position = Tile.NewRightColumnTile
, attributes = []
, body =
model
|> List.map (storyView context)
|> Element.column [ Element.spacing 8 ]
}
]
}
build :
BookBuilder (Context -> model -> Tile.View msg) model msg flags a
-> Tile.Group ( StorySelectorModel, model ) (Tile.TileMsg StorySelectorMsg msg) flags
build builder =
storyTile builder.title builder.stories builder.storiesToValue
|> Tile.linkGroup
{ init = builder.tilelist.init
, update =
\msg ( selectorModel, model ) ->
builder.tilelist.update msg model
, subscriptions = Tuple.second >> builder.tilelist.subscriptions
, views =
\context ( selectorModel, model ) ->
selectorModel
|> selectedStories
|> List.reverse
|> builder.storiesToValue
|> builder.tilelist.views
|> List.map
(\view ->
view context model
)
}

View File

@ -0,0 +1,435 @@
module UIExplorer.Tile exposing (..)
import Dict exposing (Dict)
import Element exposing (Attribute, Element)
import Element.Background as Background
import Element.Font as Font
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 Position
= FullWidthTile
| RightColumnTile
| NewRightColumnTile
| LeftColumnTile
| NewLeftColumnTile
type alias Context =
{ pagesize : PageSize
, palette : Material.Palette
}
type alias View msg =
{ title : Maybe String
, position : Position
, attributes : List (Attribute msg)
, body : Element msg
}
mapView : (a -> b) -> View a -> View b
mapView map view =
{ title = view.title
, position = view.position
, attributes = List.map (Element.mapAttribute map) view.attributes
, body = Element.map map view.body
}
mapViewList : (a -> b) -> List (View a) -> List (View b)
mapViewList map =
List.map (mapView map)
type alias Tile model msg flags =
{ init : flags -> ( model, Cmd msg )
, update : msg -> model -> ( model, Cmd msg )
, view : Context -> model -> View msg
, subscriptions : model -> Sub msg
}
type alias Group model msg flags =
{ init : flags -> ( model, Cmd msg )
, update : msg -> model -> ( model, Cmd msg )
, views : Context -> model -> List (View msg)
, subscriptions : model -> Sub msg
}
type alias LinkedGroup sharedModel model msg flags =
{ init : flags -> ( model, Cmd msg )
, update : msg -> ( sharedModel, model ) -> ( model, Cmd msg )
, views : Context -> ( sharedModel, model ) -> List (View msg)
, subscriptions : ( sharedModel, model ) -> Sub msg
}
linkGroup :
LinkedGroup sharedModel model msg flags
-> Group sharedModel upMsg flags
-> Group ( sharedModel, model ) (TileMsg upMsg msg) flags
linkGroup linked parent =
let
init_ : flags -> ( ( sharedModel, model ), Cmd (TileMsg upMsg msg) )
init_ flags =
let
( parentModel, parentCmd ) =
parent.init flags
( model, cmd ) =
linked.init flags
in
( ( parentModel, model ), Cmd.batch [ Cmd.map Previous parentCmd, Cmd.map Current cmd ] )
update_ msg ( sharedModel, model ) =
case msg of
Previous parentMsg ->
let
( newParentModel, parentCmd ) =
parent.update parentMsg sharedModel
in
( ( newParentModel, model ), Cmd.map Previous parentCmd )
Current currentMsg ->
let
( newModel, cmd ) =
linked.update currentMsg ( sharedModel, model )
in
( ( sharedModel, newModel ), Cmd.map Current cmd )
subscriptions_ ( sharedModel, model ) =
Sub.batch
[ Sub.map Current (linked.subscriptions ( sharedModel, model ))
, Sub.map Previous (parent.subscriptions sharedModel)
]
views_ pageSize ( sharedModel, model ) =
List.append
(parent.views pageSize sharedModel |> mapViewList Previous)
(linked.views pageSize ( sharedModel, model ) |> mapViewList Current)
in
{ init = init_
, update = update_
, views = views_
, subscriptions = subscriptions_
}
groupSingleton : Tile model msg flags -> Group model msg flags
groupSingleton tile =
{ init = tile.init
, update = tile.update
, views =
\pagesize model ->
List.singleton <| tile.view pagesize model
, subscriptions = tile.subscriptions
}
{-| -}
type Builder model msg flags
= Builder
{ init : flags -> ( model, Cmd msg )
, update : msg -> model -> ( model, Cmd msg )
, views : Context -> model -> List (View msg)
, subscriptions : model -> Sub msg
}
type TileMsg previous current
= Previous previous
| Current current
firstGroup : Group model msg flags -> Builder ( (), model ) (TileMsg () msg) flags
firstGroup config =
Builder
{ init = always ( (), Cmd.none )
, update = \_ m -> ( m, Cmd.none )
, views =
\_ _ ->
[]
, subscriptions = always Sub.none
}
|> nextGroup config
first : Tile model msg flags -> Builder ( (), model ) (TileMsg () msg) flags
first =
groupSingleton >> firstGroup
next :
Tile model msg flags
-> Builder modelPrevious msgPrevious flags
-> Builder ( modelPrevious, model ) (TileMsg msgPrevious msg) flags
next =
groupSingleton >> nextGroup
nextGroup :
Group model msg flags
-> Builder modelPrevious msgPrevious flags
-> Builder ( modelPrevious, model ) (TileMsg msgPrevious msg) flags
nextGroup config (Builder previous) =
let
init_ : flags -> ( ( modelPrevious, model ), Cmd (TileMsg msgPrevious msg) )
init_ flags =
let
( previousModel, previousCmds ) =
previous.init flags
( model, cmds ) =
config.init flags
in
( ( previousModel, model ), Cmd.batch [ Cmd.map Previous previousCmds, Cmd.map Current cmds ] )
update_ :
TileMsg msgPrevious msg
-> ( modelPrevious, model )
-> ( ( modelPrevious, model ), Cmd (TileMsg msgPrevious msg) )
update_ msg ( previousModel, model ) =
case msg of
Previous previousMsg ->
let
( newPreviousModel, previousCmds ) =
previous.update previousMsg previousModel
in
( ( newPreviousModel, model ), Cmd.map Previous previousCmds )
Current currentMsg ->
let
( newModel, cmds ) =
config.update currentMsg model
in
( ( previousModel, newModel ), Cmd.map Current cmds )
views_ : Context -> ( modelPrevious, model ) -> List (View (TileMsg msgPrevious msg))
views_ windowSize ( previousModel, model ) =
List.append
(previous.views windowSize previousModel |> mapViewList Previous)
(config.views windowSize model |> mapViewList Current)
subscriptions_ ( previousModel, model ) =
Sub.batch
[ Sub.map Current (config.subscriptions model)
, Sub.map Previous (previous.subscriptions previousModel)
]
in
Builder
{ init = init_
, update = update_
, views = views_
, subscriptions = subscriptions_
}
type LayoutRow msg
= OneColumn (List (View msg))
| TwoColumn (List (View msg)) (List (View msg))
type alias Layout msg =
List (LayoutRow msg)
layoutAddTile : View msg -> Layout msg -> Layout msg
layoutAddTile view layout =
case view.position of
FullWidthTile ->
case layout of
(OneColumn items) :: tail ->
OneColumn (view :: items) :: tail
_ ->
OneColumn [ view ] :: layout
LeftColumnTile ->
case layout of
(TwoColumn left right) :: tail ->
TwoColumn (view :: left) right :: tail
_ ->
TwoColumn [ view ] [] :: layout
NewLeftColumnTile ->
TwoColumn [ view ] [] :: layout
RightColumnTile ->
case layout of
(TwoColumn left right) :: tail ->
TwoColumn left (view :: right) :: tail
_ ->
TwoColumn [] [ view ] :: layout
NewRightColumnTile ->
TwoColumn [] [ view ] :: layout
layoutView : Material.Palette -> List (Attribute msg) -> View msg -> Element msg
layoutView palette attributes view =
Widget.column
(Material.cardColumn palette
|> Customize.elementColumn attributes
|> Customize.mapContent (Customize.element <| Element.height Element.fill :: view.attributes)
)
<|
List.filterMap identity
[ view.title
|> Maybe.map Element.text
|> Maybe.map (Element.el Typography.h3)
, Just view.body
]
layoutRowView : Material.Palette -> LayoutRow msg -> List (Element msg)
layoutRowView palette row =
case row of
OneColumn items ->
items
|> List.reverse
|> List.map (layoutView palette [])
TwoColumn left right ->
Element.row
[ Element.width Element.fill
, Element.spacing 10
]
[ Element.column
[ Element.width <| Element.fillPortion 2
, Element.height Element.fill
, Element.spacing 10
]
<|
List.map
(layoutView palette
[ Element.height Element.fill ]
)
<|
List.reverse left
, Element.column
[ Element.width <| Element.fillPortion 1
, Element.height Element.fill
, Element.spacing 10
]
<|
List.map
(layoutView palette
[ Element.height Element.fill ]
)
<|
List.reverse right
]
|> List.singleton
page : Builder model msg flags -> Page model msg flags
page (Builder config) =
{ init = config.init
, update = config.update
, view =
\pagesize dark model ->
let
palette =
if dark then
Material.darkPalette
else
Material.defaultPalette
in
config.views
{ pagesize = pagesize
, palette = palette
}
model
|> List.foldl layoutAddTile []
|> List.reverse
|> List.concatMap (layoutRowView palette)
|> Element.column
([ Element.padding 10
, Element.spacing 10
, Element.px 800 |> Element.width
, Element.centerX
, Font.family
[ Font.typeface "Roboto"
, Font.sansSerif
]
, Font.size 16
, Font.letterSpacing 0.5
]
++ (palette.background |> MaterialColor.textAndBackground)
)
, subscriptions = config.subscriptions
}
{-| render a markdown text into a simple panel
-}
markdown : List (Attribute ()) -> String -> Tile () () ()
markdown attributes text =
static attributes
(\_ _ ->
Markdown.toHtml [] text
|> Element.html
)
static : List (Attribute msg) -> (Context -> flags -> Element msg) -> Tile flags msg flags
static attributes tileView =
{ init = \flags -> ( flags, Cmd.none )
, update = \_ m -> ( m, Cmd.none )
, view =
\pagesize flags ->
{ title = Nothing
, body = tileView pagesize flags
, position = FullWidthTile
, attributes = attributes
}
, subscriptions = \_ -> Sub.none
}
withTitle : String -> Tile model msg flags -> Tile model msg flags
withTitle title tile =
let
settitle t v =
{ v | title = Just t }
in
{ tile
| view =
\pagesize flags ->
tile.view pagesize flags |> settitle title
}
canvas : Element msg -> Element msg
canvas view =
Element.el
[ Element.padding 30
, Element.width Element.fill
, Background.color <| MaterialColor.fromColor <| MaterialColor.gray
]
<|
Element.el
[ Element.centerX
, Element.centerY
]
view
sourceCode : String -> Element msg
sourceCode code =
("```\n" ++ code ++ "\n```")
|> Markdown.toHtml []
|> Element.html