mirror of
https://github.com/NoRedInk/noredink-ui.git
synced 2024-12-01 00:34:27 +03:00
use package for Debug.Control module
This commit is contained in:
Brooke Angel
parent
72c5547916
commit
21da9ac0db
@ -1,460 +0,0 @@
|
||||
module Debug.Control exposing
|
||||
( Control
|
||||
, value
|
||||
, bool, string
|
||||
, values, maybe, choice, list, record, field
|
||||
, map
|
||||
, view, currentValue, allValues
|
||||
)
|
||||
|
||||
{-| Create interactive controls for complex data structures.
|
||||
|
||||
@docs Control
|
||||
@docs value
|
||||
@docs bool, string
|
||||
@docs values, maybe, choice, list, record, field
|
||||
@docs map
|
||||
|
||||
@docs view, currentValue, allValues
|
||||
|
||||
-}
|
||||
|
||||
import Html exposing (Html)
|
||||
import Html.Attributes
|
||||
import Html.Events
|
||||
import Json.Decode
|
||||
import String
|
||||
|
||||
|
||||
{-| An interactive control that produces a value `a`.
|
||||
-}
|
||||
type Control a
|
||||
= Control
|
||||
{ currentValue : a
|
||||
, allValues : () -> List a
|
||||
, view : ControlView a
|
||||
}
|
||||
|
||||
|
||||
type ControlView a
|
||||
= NoView
|
||||
| SingleView (() -> Html (Control a))
|
||||
| FieldViews (List ( String, () -> Html (Control a) ))
|
||||
|
||||
|
||||
{-| A `Control` that has a static value (and no UI).
|
||||
-}
|
||||
value : a -> Control a
|
||||
value initial =
|
||||
Control
|
||||
{ currentValue = initial
|
||||
, allValues = \() -> [ initial ]
|
||||
, view = NoView
|
||||
}
|
||||
|
||||
|
||||
{-| A `Control` that chooses between a list of values with a dropdown UI.
|
||||
|
||||
The first value will be the initial value.
|
||||
|
||||
-}
|
||||
values : a -> List a -> Control a
|
||||
values current choices =
|
||||
let
|
||||
toControl x =
|
||||
( Debug.toString x, value x )
|
||||
in
|
||||
choice (toControl current) (List.map toControl choices)
|
||||
|
||||
|
||||
{-| A `Control` that wraps another control in a `Maybe`, which a checkbox UI.
|
||||
|
||||
The `Bool` parameter is the initial value, where `False` is `Nothing`,
|
||||
and `True` is `Just` with the value of the nested control.
|
||||
|
||||
-}
|
||||
maybe : Bool -> Control a -> Control (Maybe a)
|
||||
maybe isJust (Control valu) =
|
||||
Control
|
||||
{ currentValue =
|
||||
if isJust then
|
||||
Just valu.currentValue
|
||||
|
||||
else
|
||||
Nothing
|
||||
, allValues =
|
||||
\() ->
|
||||
Nothing
|
||||
:: List.map Just (valu.allValues ())
|
||||
, view =
|
||||
SingleView <|
|
||||
\() ->
|
||||
Html.span
|
||||
[ Html.Attributes.style "white-space" "nowrap"
|
||||
]
|
||||
[ Html.input
|
||||
[ Html.Attributes.type_ "checkbox"
|
||||
, Html.Events.onCheck (\a -> maybe a (Control valu))
|
||||
, Html.Attributes.checked isJust
|
||||
]
|
||||
[]
|
||||
, Html.text " "
|
||||
, if isJust then
|
||||
view_ (maybe isJust) (Control valu)
|
||||
|
||||
else
|
||||
Html.text "Nothing"
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
{-| A `Control` that toggles a `Bool` with a checkbox UI.
|
||||
-}
|
||||
bool : Bool -> Control Bool
|
||||
bool valu =
|
||||
Control
|
||||
{ currentValue = valu
|
||||
, allValues =
|
||||
\() ->
|
||||
[ valu
|
||||
, not valu
|
||||
]
|
||||
, view =
|
||||
SingleView <|
|
||||
\() ->
|
||||
Html.span []
|
||||
[ Html.input
|
||||
[ Html.Attributes.type_ "checkbox"
|
||||
, Html.Events.onCheck bool
|
||||
, Html.Attributes.checked valu
|
||||
]
|
||||
[]
|
||||
, Html.text " "
|
||||
, Html.text <| Debug.toString valu
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
{-| A `Control` that allows text input.
|
||||
-}
|
||||
string : String -> Control String
|
||||
string valu =
|
||||
Control
|
||||
{ currentValue = valu
|
||||
, allValues =
|
||||
\() ->
|
||||
[ valu
|
||||
, ""
|
||||
, "short"
|
||||
, "Longwordyesverylongwithnospacessupercalifragilisticexpialidocious"
|
||||
, "Long text lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
|
||||
]
|
||||
, view =
|
||||
SingleView <|
|
||||
\() ->
|
||||
Html.input
|
||||
[ Html.Attributes.value valu
|
||||
, Html.Events.onInput string
|
||||
]
|
||||
[]
|
||||
}
|
||||
|
||||
|
||||
{-| A `Control` that chooses between a list of nested controls.
|
||||
|
||||
This will crash if you provide an empty list.
|
||||
|
||||
The first entry will be the initial value.
|
||||
|
||||
-}
|
||||
choice : ( String, Control a ) -> List ( String, Control a ) -> Control a
|
||||
choice =
|
||||
choice_ []
|
||||
|
||||
|
||||
choice_ :
|
||||
List ( String, Control a )
|
||||
-> ( String, Control a )
|
||||
-> List ( String, Control a )
|
||||
-> Control a
|
||||
choice_ left current right =
|
||||
Control
|
||||
{ currentValue = current |> Tuple.second |> currentValue
|
||||
, allValues =
|
||||
\() ->
|
||||
(List.reverse left ++ [ current ] ++ right)
|
||||
|> List.map (Tuple.second >> allValues)
|
||||
|> List.concat
|
||||
, view =
|
||||
SingleView <|
|
||||
\() ->
|
||||
let
|
||||
option selected ( label, valu ) =
|
||||
Html.option
|
||||
[ Html.Attributes.selected selected ]
|
||||
[ Html.text label ]
|
||||
|
||||
selectNew i =
|
||||
let
|
||||
all =
|
||||
List.reverse left
|
||||
++ [ current ]
|
||||
++ right
|
||||
|
||||
left_ =
|
||||
all
|
||||
|> List.take i
|
||||
|> List.reverse
|
||||
|
||||
current_ =
|
||||
all
|
||||
|> List.drop i
|
||||
|> List.head
|
||||
|> Maybe.withDefault current
|
||||
|
||||
right_ =
|
||||
all
|
||||
|> List.drop (i + 1)
|
||||
in
|
||||
choice_ left_ current_ right_ |> Debug.log "new"
|
||||
|
||||
updateChild new =
|
||||
choice_ left ( Tuple.first current, new ) right
|
||||
in
|
||||
Html.div []
|
||||
[ Html.map selectNew <|
|
||||
Html.select
|
||||
[ Html.Events.on "change" (Json.Decode.at [ "target", "selectedIndex" ] Json.Decode.int)
|
||||
]
|
||||
<|
|
||||
List.concat
|
||||
[ List.map (option False) <| List.reverse left
|
||||
, [ option True current ]
|
||||
, List.map (option False) right
|
||||
]
|
||||
, view_ updateChild (Tuple.second current)
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
{-| A `Control` that provides a list of selected length.
|
||||
-}
|
||||
list : Control a -> Control (List a)
|
||||
list itemControl =
|
||||
list_ itemControl 1 0 10
|
||||
|
||||
|
||||
flip : (a -> b -> c) -> b -> a -> c
|
||||
flip fn param1 param2 =
|
||||
fn param2 param1
|
||||
|
||||
|
||||
list_ : Control a -> Int -> Int -> Int -> Control (List a)
|
||||
list_ itemControl current min max =
|
||||
let
|
||||
makeList n =
|
||||
allValues itemControl
|
||||
|> List.repeat n
|
||||
|> List.concat
|
||||
|> List.take n
|
||||
in
|
||||
Control
|
||||
{ currentValue = makeList current
|
||||
, allValues =
|
||||
\() ->
|
||||
[ 1, 0, 3 ]
|
||||
|> List.filter (\x -> x > min && x < max)
|
||||
|> flip List.append [ min, max ]
|
||||
|> List.map makeList
|
||||
, view =
|
||||
SingleView <|
|
||||
\() ->
|
||||
let
|
||||
selectNew new =
|
||||
list_ itemControl new min max
|
||||
in
|
||||
Html.map
|
||||
(String.toInt
|
||||
>> Maybe.withDefault current
|
||||
>> selectNew
|
||||
)
|
||||
<|
|
||||
Html.label []
|
||||
[ Html.text ""
|
||||
, Html.input
|
||||
[ Html.Attributes.type_ "range"
|
||||
, Html.Attributes.min <| Debug.toString min
|
||||
, Html.Attributes.max <| Debug.toString max
|
||||
, Html.Attributes.step <| Debug.toString 1
|
||||
, Html.Attributes.attribute "value" <| Debug.toString current
|
||||
, Html.Events.on "input" Html.Events.targetValue
|
||||
]
|
||||
[]
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
{-| Create a `Control` representing a record with multiple fields.
|
||||
|
||||
This uses an API similar to [elm-decode-pipeline](http://package.elm-lang.org/packages/NoRedInk/elm-decode-pipeline/latest).
|
||||
|
||||
You will use this with `field`.
|
||||
|
||||
import Debug.Control exposing (field, record, string)
|
||||
|
||||
type alias Point =
|
||||
{ x : String
|
||||
, y : String
|
||||
}
|
||||
|
||||
pointControl : Control Point
|
||||
pointControl =
|
||||
record Point
|
||||
|> field "x" (string "initial x value")
|
||||
|> field "y" (string "initial y value")
|
||||
|
||||
-}
|
||||
record : a -> Control a
|
||||
record fn =
|
||||
Control
|
||||
{ currentValue = fn
|
||||
, allValues = \() -> [ fn ]
|
||||
, view = FieldViews []
|
||||
}
|
||||
|
||||
|
||||
{-| Used with `record` to create a `Control` representing a record.
|
||||
|
||||
See [`record`](#record).
|
||||
|
||||
-}
|
||||
field : String -> Control a -> Control (a -> b) -> Control b
|
||||
field name (Control valu) (Control pipeline) =
|
||||
Control
|
||||
{ currentValue = pipeline.currentValue valu.currentValue
|
||||
, allValues =
|
||||
\() ->
|
||||
valu.allValues ()
|
||||
|> List.concatMap
|
||||
(\v ->
|
||||
List.map (\p -> p v)
|
||||
(pipeline.allValues ())
|
||||
)
|
||||
, view =
|
||||
let
|
||||
otherFields =
|
||||
case pipeline.view of
|
||||
FieldViews fs ->
|
||||
List.map (Tuple.mapSecond (\x -> \() -> Html.map (field name (Control valu)) (x ())))
|
||||
fs
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
newView () =
|
||||
view_ (\v -> field name v (Control pipeline)) (Control valu)
|
||||
in
|
||||
FieldViews (( name, newView ) :: otherFields)
|
||||
}
|
||||
|
||||
|
||||
{-| Transform the value produced by a `Control`.
|
||||
-}
|
||||
map : (a -> b) -> Control a -> Control b
|
||||
map fn (Control a) =
|
||||
let
|
||||
mapTuple ( label, valu ) =
|
||||
( label, map fn valu )
|
||||
in
|
||||
Control
|
||||
{ currentValue = fn a.currentValue
|
||||
, allValues = \() -> List.map fn (a.allValues ())
|
||||
, view =
|
||||
case a.view of
|
||||
NoView ->
|
||||
NoView
|
||||
|
||||
SingleView v ->
|
||||
SingleView <|
|
||||
\() -> Html.map (map fn) (v ())
|
||||
|
||||
FieldViews fs ->
|
||||
FieldViews <|
|
||||
List.map (Tuple.mapSecond (\v -> \() -> Html.map (map fn) (v ()))) fs
|
||||
}
|
||||
|
||||
|
||||
{-| Gets the current value of a `Control`.
|
||||
-}
|
||||
currentValue : Control a -> a
|
||||
currentValue (Control c) =
|
||||
c.currentValue
|
||||
|
||||
|
||||
{-| TODO: revise API
|
||||
-}
|
||||
allValues : Control a -> List a
|
||||
allValues (Control c) =
|
||||
c.allValues ()
|
||||
|
||||
|
||||
{-| Renders the interactive UI for a `Control`.
|
||||
-}
|
||||
view : (Control a -> msg) -> Control a -> Html msg
|
||||
view msg (Control c) =
|
||||
let
|
||||
fieldRow ( name, column ) =
|
||||
Html.tr []
|
||||
[ Html.td
|
||||
[ Html.Attributes.style "text-align" "right" ]
|
||||
[ Html.text name ]
|
||||
, Html.td [] [ Html.text " = " ]
|
||||
, Html.td [] [ column () ]
|
||||
]
|
||||
in
|
||||
Html.div []
|
||||
[ view_ msg (Control c)
|
||||
]
|
||||
|
||||
|
||||
view_ : (Control a -> msg) -> Control a -> Html msg
|
||||
view_ msg (Control c) =
|
||||
let
|
||||
fieldRow ( name, column ) =
|
||||
Html.tr
|
||||
[ Html.Attributes.style
|
||||
"vertical-align"
|
||||
"text-top"
|
||||
]
|
||||
[ Html.td [] [ Html.text "," ]
|
||||
, Html.td
|
||||
[ Html.Attributes.style "text-align" "right"
|
||||
]
|
||||
[ Html.text name ]
|
||||
, Html.td [] [ Html.text " = " ]
|
||||
, Html.td [] [ column () ]
|
||||
]
|
||||
in
|
||||
case c.view of
|
||||
NoView ->
|
||||
Html.text ""
|
||||
|
||||
SingleView v ->
|
||||
Html.map msg <| v ()
|
||||
|
||||
FieldViews fs ->
|
||||
List.concat
|
||||
[ [ Html.tr
|
||||
[ Html.Attributes.style
|
||||
"vertical-align"
|
||||
"text-top"
|
||||
]
|
||||
[ Html.td [] [ Html.text "{" ] ]
|
||||
]
|
||||
, fs
|
||||
|> List.reverse
|
||||
|> List.map fieldRow
|
||||
, [ Html.tr [] [ Html.td [] [ Html.text "}" ] ] ]
|
||||
]
|
||||
|> Html.table []
|
||||
|> Html.map msg
|
||||
@ -7,6 +7,7 @@
|
||||
"elm-version": "0.19.0",
|
||||
"dependencies": {
|
||||
"direct": {
|
||||
"NoRedInk/elm-debug-controls-without-datepicker": "1.0.1",
|
||||
"avh4/elm-color": "1.0.0",
|
||||
"elm/browser": "1.0.1",
|
||||
"elm/core": "1.0.2",
|
||||
|
||||
Loading…
Reference in New Issue
Block a user