mirror of
https://github.com/Orasund/elm-ui-widgets.git
synced 2024-09-11 06:25:32 +03:00
Added a UIExplorer POC
This commit is contained in:
Christophe de Vienne
parent
aa2b74dde2
commit
260429be75
8
explorer/README.md
Normal file
8
explorer/README.md
Normal file
@ -0,0 +1,8 @@
|
||||
Explorer
|
||||
========
|
||||
|
||||
To run the explorer :
|
||||
|
||||
```Bash
|
||||
elm-live src/Main.elm
|
||||
```
|
||||
38
explorer/elm.json
Normal file
38
explorer/elm.json
Normal 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/svg": "1.0.1",
|
||||
"elm-explorations/markdown": "1.0.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"
|
||||
},
|
||||
"indirect": {
|
||||
"elm/json": "1.1.3",
|
||||
"elm/regex": "1.0.0",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/url": "1.0.0",
|
||||
"elm/virtual-dom": "1.0.2",
|
||||
"fredcy/elm-parseint": "2.0.1",
|
||||
"ianmackenzie/elm-units": "2.9.0",
|
||||
"zwilias/elm-rosetree": "1.5.0"
|
||||
}
|
||||
},
|
||||
"test-dependencies": {
|
||||
"direct": {},
|
||||
"indirect": {}
|
||||
}
|
||||
}
|
||||
222
explorer/src/Button.elm
Normal file
222
explorer/src/Button.elm
Normal file
@ -0,0 +1,222 @@
|
||||
module Button exposing (page)
|
||||
|
||||
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 Tooling
|
||||
import UiExplorer
|
||||
import Widget
|
||||
import Widget.Customize as Customize
|
||||
import Widget.Icon as Icon exposing (Icon)
|
||||
import Widget.Material as Material exposing (Palette, containedButton, darkPalette, defaultPalette)
|
||||
import Widget.Material.Color as MaterialColor
|
||||
import Widget.Material.Typography as Typography
|
||||
|
||||
|
||||
page =
|
||||
Tooling.firstBloc (intro |> Tooling.withBlocTitle "Button")
|
||||
|> Tooling.nextBlocList book
|
||||
|> Tooling.page
|
||||
|
||||
|
||||
intro =
|
||||
Tooling.markdown
|
||||
""" A simple button """
|
||||
|
||||
|
||||
book =
|
||||
Story.book (Just "States") buttonBlocs
|
||||
|> Story.addStory
|
||||
(Story "Palette"
|
||||
[ ( "default", defaultPalette )
|
||||
, ( "dark", darkPalette )
|
||||
]
|
||||
)
|
||||
|> Story.addStory
|
||||
(Story "Text"
|
||||
[ ( "OK", "OK" )
|
||||
, ( "Cancel", "Cancel" )
|
||||
, ( "Something a little too long", "Something a little too long" )
|
||||
]
|
||||
)
|
||||
|> Story.addStory
|
||||
(Story "Icon"
|
||||
[ ( "done"
|
||||
, MaterialIcons.done
|
||||
|> Icon.elmMaterialIcons Color
|
||||
)
|
||||
]
|
||||
)
|
||||
|> Story.addStory
|
||||
(Story "onPress"
|
||||
[ ( "Something", Just Noop )
|
||||
, ( "Nothing", Nothing )
|
||||
]
|
||||
)
|
||||
|> Story.build
|
||||
|
||||
|
||||
type alias Model =
|
||||
Int
|
||||
|
||||
|
||||
type Msg
|
||||
= Increase Int
|
||||
| Decrease Int
|
||||
| Reset
|
||||
| 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
|
||||
|
||||
|
||||
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
|
||||
|
||||
|
||||
viewButton palette text icon onPress _ _ =
|
||||
Tooling.canvas <|
|
||||
Widget.button (containedButton palette)
|
||||
{ text = text
|
||||
, icon = icon
|
||||
, onPress = onPress
|
||||
}
|
||||
|
||||
|
||||
view palette _ _ _ _ model =
|
||||
let
|
||||
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
|
||||
[ 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 ])
|
||||
)
|
||||
12
explorer/src/Main.elm
Normal file
12
explorer/src/Main.elm
Normal file
@ -0,0 +1,12 @@
|
||||
module Main exposing (main)
|
||||
|
||||
import Button
|
||||
import UiExplorer
|
||||
|
||||
|
||||
pages =
|
||||
UiExplorer.firstPage "Button" Button.page
|
||||
|
||||
|
||||
main =
|
||||
UiExplorer.application UiExplorer.defaultConfig pages
|
||||
232
explorer/src/Story.elm
Normal file
232
explorer/src/Story.elm
Normal file
@ -0,0 +1,232 @@
|
||||
module Story exposing (..)
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import Element exposing (Element)
|
||||
import Element.Input exposing (Label, Option, labelAbove, option, radio)
|
||||
import SelectList exposing (SelectList)
|
||||
import Tooling
|
||||
import UiExplorer exposing (PageSize)
|
||||
|
||||
|
||||
type alias Story a =
|
||||
{ label : String
|
||||
, options : List ( String, a )
|
||||
}
|
||||
|
||||
|
||||
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 ))
|
||||
, subscriptions : model -> Sub msg
|
||||
}
|
||||
|
||||
|
||||
type alias BookBuilder view model msg flags =
|
||||
{ title : Maybe String
|
||||
, stories : List ( String, List String )
|
||||
, bloclist : BlocList view model msg flags
|
||||
}
|
||||
|
||||
|
||||
book :
|
||||
Maybe String
|
||||
-> BlocList 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
|
||||
, 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
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
|
||||
initBlocs :
|
||||
{ init : flags -> ( model, Cmd msg )
|
||||
, update : msg -> model -> ( model, Cmd msg )
|
||||
, subscriptions : model -> Sub msg
|
||||
}
|
||||
-> BlocList view model msg flags
|
||||
initBlocs { init, update, subscriptions } =
|
||||
{ init = init
|
||||
, titles = []
|
||||
, update = update
|
||||
, views = []
|
||||
, subscriptions = subscriptions
|
||||
}
|
||||
|
||||
|
||||
addBloc : Maybe String -> view -> BlocList view model msg flags -> BlocList view model msg flags
|
||||
addBloc title view bloclist =
|
||||
{ bloclist
|
||||
| titles = List.append bloclist.titles [ title ]
|
||||
, views = List.append bloclist.views [ [ ( [], view ) ] ]
|
||||
}
|
||||
|
||||
|
||||
type alias StorySelectorModel =
|
||||
List ( String, SelectList String )
|
||||
|
||||
|
||||
selectedStory : StorySelectorModel -> String
|
||||
selectedStory =
|
||||
List.map
|
||||
(Tuple.second >> SelectList.selected)
|
||||
>> String.join "/"
|
||||
|
||||
|
||||
selectStory : String -> String -> StorySelectorModel -> StorySelectorModel
|
||||
selectStory story value =
|
||||
List.map
|
||||
(\( label, options ) ->
|
||||
if label == story then
|
||||
( label
|
||||
, options
|
||||
|> SelectList.attempt (SelectList.selectBeforeIf <| (==) value)
|
||||
|> SelectList.attempt (SelectList.selectAfterIf <| (==) value)
|
||||
)
|
||||
|
||||
else
|
||||
( label, options )
|
||||
)
|
||||
|
||||
|
||||
type StorySelectorMsg
|
||||
= StorySelect String String
|
||||
|
||||
|
||||
storyHelp : ( String, List String ) -> Maybe ( String, SelectList String )
|
||||
storyHelp ( label, options ) =
|
||||
SelectList.fromList options
|
||||
|> Maybe.map (Tuple.pair label)
|
||||
|
||||
|
||||
storyBloc : Maybe String -> List ( String, List String ) -> Tooling.BlocList StorySelectorModel StorySelectorMsg flags
|
||||
storyBloc title stories =
|
||||
{ init =
|
||||
\_ ->
|
||||
( stories
|
||||
|> List.reverse
|
||||
|> List.filterMap storyHelp
|
||||
, Cmd.none
|
||||
)
|
||||
, update =
|
||||
\msg model ->
|
||||
case msg of
|
||||
StorySelect story value ->
|
||||
( selectStory story value model, Cmd.none )
|
||||
, titles = [ title ]
|
||||
, subscriptions = always Sub.none
|
||||
, views =
|
||||
\_ model ->
|
||||
[ { 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
|
||||
}
|
||||
)
|
||||
|> Element.column []
|
||||
}
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
build :
|
||||
BookBuilder (PageSize -> model -> Element msg) model msg flags
|
||||
-> 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
|
||||
|> Tooling.linkBlocList
|
||||
{ init = builder.bloclist.init
|
||||
, update =
|
||||
\msg ( selectorModel, model ) ->
|
||||
builder.bloclist.update msg model
|
||||
, titles = builder.bloclist.titles
|
||||
, subscriptions = Tuple.second >> builder.bloclist.subscriptions
|
||||
, views =
|
||||
\pagesize ( selectorModel, model ) ->
|
||||
List.map
|
||||
(\viewsDict ->
|
||||
{ sidebloc = False
|
||||
, body =
|
||||
(Dict.get (selectedStory selectorModel) viewsDict
|
||||
|> Maybe.withDefault (\_ _ -> Element.none)
|
||||
)
|
||||
pagesize
|
||||
model
|
||||
}
|
||||
)
|
||||
views
|
||||
}
|
||||
328
explorer/src/Tooling.elm
Normal file
328
explorer/src/Tooling.elm
Normal file
@ -0,0 +1,328 @@
|
||||
module Tooling exposing (..)
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import Element exposing (Element)
|
||||
import Markdown
|
||||
import SelectList exposing (SelectList)
|
||||
import UiExplorer exposing (Page, PageSize)
|
||||
import Widget
|
||||
import Widget.Material as Material
|
||||
import Widget.Material.Typography as Typography
|
||||
|
||||
|
||||
type alias BlocView msg =
|
||||
{ body : Element msg
|
||||
, sidebloc : Bool
|
||||
}
|
||||
|
||||
|
||||
mapBlocView : (a -> b) -> BlocView a -> BlocView b
|
||||
mapBlocView map view =
|
||||
{ body = Element.map map view.body
|
||||
, sidebloc = view.sidebloc
|
||||
}
|
||||
|
||||
|
||||
mapBlocViewList : (a -> b) -> List (BlocView a) -> List (BlocView b)
|
||||
mapBlocViewList map =
|
||||
List.map (mapBlocView map)
|
||||
|
||||
|
||||
type alias Bloc model msg flags =
|
||||
{ init : flags -> ( model, Cmd msg )
|
||||
, update : msg -> model -> ( model, Cmd msg )
|
||||
, title : Maybe String
|
||||
, view : PageSize -> model -> BlocView msg
|
||||
, subscriptions : model -> Sub msg
|
||||
}
|
||||
|
||||
|
||||
type alias BlocList model msg flags =
|
||||
{ init : flags -> ( model, Cmd msg )
|
||||
, update : msg -> model -> ( model, Cmd msg )
|
||||
, titles : List (Maybe String)
|
||||
, views : PageSize -> model -> List (BlocView msg)
|
||||
, subscriptions : model -> Sub msg
|
||||
}
|
||||
|
||||
|
||||
type alias LinkedBlockList sharedModel model msg flags =
|
||||
{ init : flags -> ( model, Cmd msg )
|
||||
, update : msg -> ( sharedModel, model ) -> ( model, Cmd msg )
|
||||
, titles : List (Maybe String)
|
||||
, views : PageSize -> ( sharedModel, model ) -> List (BlocView msg)
|
||||
, subscriptions : ( sharedModel, model ) -> Sub msg
|
||||
}
|
||||
|
||||
|
||||
linkBlocList :
|
||||
LinkedBlockList sharedModel model msg flags
|
||||
-> BlocList sharedModel upMsg flags
|
||||
-> BlocList ( sharedModel, model ) (BlocMsg upMsg msg) flags
|
||||
linkBlocList linked parent =
|
||||
let
|
||||
init_ : flags -> ( ( sharedModel, model ), Cmd (BlocMsg 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 )
|
||||
|
||||
titles_ =
|
||||
List.append parent.titles linked.titles
|
||||
|
||||
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 |> mapBlocViewList Previous)
|
||||
(linked.views pageSize ( sharedModel, model ) |> mapBlocViewList Current)
|
||||
in
|
||||
{ init = init_
|
||||
, update = update_
|
||||
, titles = titles_
|
||||
, views = views_
|
||||
, subscriptions = subscriptions_
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- addLinkedBlocList :
|
||||
-- LinkedBlockList sharedModel model msg flags
|
||||
-- -> BlocList ( sharedModel, previousModel ) upMsg flags
|
||||
-- -> BlocList ( sharedModel, ( model, previousModel ) ) (BlocMsg upMsg msg) flags
|
||||
|
||||
|
||||
blocListSingleton : Bloc model msg flags -> BlocList model msg flags
|
||||
blocListSingleton bloc =
|
||||
{ init = bloc.init
|
||||
, update = bloc.update
|
||||
, titles = List.singleton bloc.title
|
||||
, views =
|
||||
\pagesize model ->
|
||||
List.singleton <| bloc.view pagesize model
|
||||
, subscriptions = bloc.subscriptions
|
||||
}
|
||||
|
||||
|
||||
{-| -}
|
||||
type BlocBuilder model msg flags
|
||||
= BlocBuilder
|
||||
{ init : flags -> ( model, Cmd msg )
|
||||
, update : msg -> model -> ( model, Cmd msg )
|
||||
, views : PageSize -> model -> List (BlocView msg)
|
||||
, subscriptions : model -> Sub msg
|
||||
, meta : List { title : Maybe String }
|
||||
}
|
||||
|
||||
|
||||
type BlocMsg previous current
|
||||
= Previous previous
|
||||
| Current current
|
||||
|
||||
|
||||
firstBloc : Bloc model msg flags -> BlocBuilder ( (), model ) (BlocMsg () msg) flags
|
||||
firstBloc config =
|
||||
BlocBuilder
|
||||
{ init = always ( (), Cmd.none )
|
||||
, update = \_ m -> ( m, Cmd.none )
|
||||
, views =
|
||||
\_ _ ->
|
||||
[]
|
||||
, subscriptions = always Sub.none
|
||||
, meta = []
|
||||
}
|
||||
|> nextBloc config
|
||||
|
||||
|
||||
nextBloc :
|
||||
Bloc model msg flags
|
||||
-> BlocBuilder modelPrevious msgPrevious flags
|
||||
-> BlocBuilder ( modelPrevious, model ) (BlocMsg msgPrevious msg) flags
|
||||
nextBloc =
|
||||
blocListSingleton >> nextBlocList
|
||||
|
||||
|
||||
nextBlocList :
|
||||
BlocList model msg flags
|
||||
-> BlocBuilder modelPrevious msgPrevious flags
|
||||
-> BlocBuilder ( modelPrevious, model ) (BlocMsg msgPrevious msg) flags
|
||||
nextBlocList config (BlocBuilder previous) =
|
||||
let
|
||||
init_ : flags -> ( ( modelPrevious, model ), Cmd (BlocMsg 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_ :
|
||||
BlocMsg msgPrevious msg
|
||||
-> ( modelPrevious, model )
|
||||
-> ( ( modelPrevious, model ), Cmd (BlocMsg 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_ : PageSize -> ( modelPrevious, model ) -> List (BlocView (BlocMsg msgPrevious msg))
|
||||
views_ windowSize ( previousModel, model ) =
|
||||
List.append
|
||||
(previous.views windowSize previousModel |> mapBlocViewList Previous)
|
||||
(config.views windowSize model |> mapBlocViewList Current)
|
||||
|
||||
subscriptions_ ( previousModel, model ) =
|
||||
Sub.batch
|
||||
[ Sub.map Current (config.subscriptions model)
|
||||
, Sub.map Previous (previous.subscriptions previousModel)
|
||||
]
|
||||
in
|
||||
BlocBuilder
|
||||
{ init = init_
|
||||
, update = update_
|
||||
, views = views_
|
||||
, subscriptions = subscriptions_
|
||||
, meta =
|
||||
List.append
|
||||
previous.meta
|
||||
(List.map (\title -> { title = title }) config.titles)
|
||||
}
|
||||
|
||||
|
||||
page : BlocBuilder model msg flags -> Page model msg flags
|
||||
page (BlocBuilder config) =
|
||||
{ init = config.init
|
||||
, update = config.update
|
||||
, view =
|
||||
\pagesize model ->
|
||||
let
|
||||
( sideblocs, blocs ) =
|
||||
config.views pagesize model
|
||||
|> List.map2
|
||||
(\meta view ->
|
||||
( view.sidebloc
|
||||
, 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
|
||||
]
|
||||
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 text =
|
||||
static
|
||||
(\_ _ ->
|
||||
Markdown.toHtml [] text
|
||||
|> Element.html
|
||||
)
|
||||
|
||||
|
||||
static : (PageSize -> flags -> Element msg) -> Bloc flags msg flags
|
||||
static blocView =
|
||||
{ init = \flags -> ( flags, Cmd.none )
|
||||
, title = Nothing
|
||||
, update = \_ m -> ( m, Cmd.none )
|
||||
, view = \pagesize flags -> { body = blocView pagesize flags, sidebloc = False }
|
||||
, subscriptions = \_ -> Sub.none
|
||||
}
|
||||
|
||||
|
||||
withBlocTitle : String -> Bloc model msg flags -> Bloc model msg flags
|
||||
withBlocTitle title bloc =
|
||||
{ bloc | title = Just title }
|
||||
|
||||
|
||||
canvas : Element msg -> Element msg
|
||||
canvas view =
|
||||
Element.el
|
||||
[ Element.padding 30
|
||||
, Element.width Element.fill
|
||||
]
|
||||
<|
|
||||
Element.el
|
||||
[ Element.centerX
|
||||
, Element.width Element.shrink
|
||||
]
|
||||
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 }
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user