imagebot

├── .envrc ├── .github └── workflows │ └── CI.yml ├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── PUBLISHING.md ├── README.md ├── docs ├── eagle.svg ├── giraffe.svg ├── index.html └── monkey.svg ├── elm.json ├── examples ├── .gitignore ├── AnimalExample.elm ├── DropboxExample.elm ├── LICENSE.md ├── Main.elm ├── RecursionExample.elm ├── eagle.svg ├── elm.json ├── giraffe.svg └── monkey.svg ├── package.json ├── screenshot.gif ├── shell.nix ├── src └── Debug │ └── Control.elm └── tests ├── .gitignore └── Controls ├── ComplexChoiceTest.elm ├── DateTest.elm ├── ListTest.elm ├── RecursionTest.elm ├── SimpleChoiceTest.elm └── StringTest.elm /.envrc: -------------------------------------------------------------------------------- 1 | use nix 2 | -------------------------------------------------------------------------------- /.github/workflows/CI.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: 6 | - main 7 | - 'release/*' 8 | pull_request: 9 | branches: 10 | - main 11 | 12 | jobs: 13 | build: 14 | runs-on: ubuntu-latest 15 | 16 | steps: 17 | - uses: actions/checkout@v3 18 | - uses: actions/setup-node@v3 19 | with: 20 | node-version: current 21 | - run: npm install 22 | - run: npm test 23 | 24 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /elm-stuff/ 2 | /node_modules/ 3 | /package-lock.json 4 | /documentation.json 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | 3 | language: node_js 4 | node_js: "12" 5 | 6 | cache: 7 | directories: 8 | - node_modules 9 | 10 | install: 11 | - npm install 12 | 13 | script: 14 | - npm test 15 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## 2.2.3 2 | 3 | - `datetimepicker-legacy` is replaced with [``](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/datetime-local) [#16](https://github.com/avh4/elm-debug-controls/pull/16) 4 | - Record views no longer show an extra leading comma [#15](https://github.com/avh4/elm-debug-controls/pull/15) 5 | 6 | 7 | ## 2.2.2 8 | 9 | - Bump version bounds for elm-css dependency 10 | 11 | 12 | ## 2.2.1 13 | 14 | - Record field inputs now have labels (for accessibility) 15 | 16 | 17 | ## 2.2.0 18 | 19 | - Added `stringTextarea` control 20 | 21 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | 2 | # Dev environment 3 | 4 | 1. One of: 5 | - If you use [`nix-direnv`](https://github.com/nix-community/nix-direnv), simply `direnv allow` 6 | - Else if you use [nix](https://nixos.org/), `nix-shell` 7 | - Else install a stable version of [nodejs](https://nodejs.org/) via whatever means you prefer 8 | 2. `npm install` 9 | 3. `npm test` 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2016-2019 Aaron VonderHaar 2 | Copyright 2019 Tessa Kelly 3 | 4 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 7 | 8 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 9 | 10 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 11 | 12 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 13 | -------------------------------------------------------------------------------- /PUBLISHING.md: -------------------------------------------------------------------------------- 1 | - `git fetch` 2 | - `git switch -c release/$VERSION origin/main` 3 | - `npx elm bump` 4 | - review `CHANGELOG.md` 5 | - `npm run-script build-site` 6 | - Stage the changes 7 | - `git commit -m "Prepare $VERSION release"` 8 | - `git push -u origin HEAD` 9 | - Wait for CI, and approve the PR 10 | - `git tag $VERSION` 11 | - `git push origin $VERSION` 12 | - `npx elm publish` 13 | - `Merge the PR` 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/avh4/elm-debug-controls.svg?branch=master)](https://travis-ci.org/avh4/elm-debug-controls) 2 | [![Latest Version](https://img.shields.io/elm-package/v/avh4/elm-debug-controls.svg?label=version)](https://package.elm-lang.org/packages/avh4/elm-debug-controls/latest/) 3 | 4 | # elm-debug-controls 5 | 6 | This package helps you easily build interactive UIs for complex data structures. 7 | The resulting controls are not meant for building end-user UIs, 8 | but they are useful for quickly building debugging consoles, documentation, and style guides. 9 | 10 | ## Demo 11 | 12 | https://avh4.github.io/elm-debug-controls/ 13 | 14 | ## Usage 15 | 16 | Suppose we have an Elm data structure like the following and want to create a simple debugging tool to experiment with different values: 17 | 18 | ```elm 19 | import Time 20 | 21 | type alias UploadRequest = 22 | { path : String 23 | , mode : WriteMode 24 | , autorename : Bool 25 | , clientModified : Maybe Time.Posix 26 | , mute : Bool 27 | , content : String 28 | } 29 | 30 | type WriteMode 31 | = Add 32 | | Overwrite 33 | | Update String 34 | ``` 35 | 36 | Using `elm-debug-controls`, we can quickly create an interactive UI to create `UploadRequest` values: 37 | 38 | ```sh 39 | elm install avh4/elm-debug-controls 40 | ``` 41 | 42 | ```elm 43 | import Debug.Control exposing (bool, choice, field, map, record, string, value) 44 | 45 | type alias Model = 46 | { ... 47 | , uploadRequest : Debug.Control.Control UploadRequest 48 | } 49 | 50 | init : Model 51 | init = 52 | { ... 53 | , uploadRequest = 54 | record UploadRequest 55 | |> field "path" (string "/demo.txt") 56 | |> field "mode" 57 | (choice 58 | [ ( "Add", value Add ) 59 | , ( "Overwrite", value Overwrite ) 60 | , ( "Update rev", map Update <| string "123abcdef" ) 61 | ] 62 | ) 63 | |> field "autorename" (bool False) 64 | |> field "clientModified" 65 | (maybe False <| date Time.utc <| Time.millisToPosix 0) 66 | |> field "mute" (bool False) 67 | |> field "content" (string "HELLO.") 68 | } 69 | ``` 70 | 71 | 72 | Now we can hook the control up to our view: 73 | 74 | ```elm 75 | type Msg 76 | = ... 77 | | ChangeUploadRequest (Debug.Control.Control UploadRequest) 78 | 79 | update : Msg -> Model -> Model 80 | update msg model = 81 | case msg of 82 | ... 83 | ChangeUploadRequest uploadRequest -> 84 | { model | uploadRequest = uploadRequest } 85 | 86 | view : Model -> Html Msg 87 | view model = 88 | ... 89 | Debug.Control.view ChangeUploadRequest model.uploadRequest 90 | ``` 91 | 92 | We now have an interactive UI that looks like this: 93 | 94 | ![Screen capture of the interactive UI](https://github.com/avh4/elm-debug-controls/raw/master/screenshot.gif) 95 | 96 | Finally, we can use the `UploadResponse` value elsewhere in our program with: 97 | 98 | ```elm 99 | Debug.Control.currentValue model.uploadRequest 100 | ``` 101 | -------------------------------------------------------------------------------- /docs/giraffe.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/monkey.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 248 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "avh4/elm-debug-controls", 4 | "summary": "Easily create interactive UIs for complex data structures", 5 | "license": "BSD-3-Clause", 6 | "version": "2.2.3", 7 | "exposed-modules": [ 8 | "Debug.Control" 9 | ], 10 | "elm-version": "0.19.0 <= v < 0.20.0", 11 | "dependencies": { 12 | "elm/core": "1.0.0 <= v < 2.0.0", 13 | "elm/html": "1.0.0 <= v < 2.0.0", 14 | "elm/json": "1.1.3 <= v < 2.0.0", 15 | "elm/time": "1.0.0 <= v < 2.0.0", 16 | "justinmimbs/time-extra": "1.1.0 <= v < 2.0.0" 17 | }, 18 | "test-dependencies": { 19 | "elm-explorations/test": "2.0.0 <= v < 3.0.0" 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /examples/.gitignore: -------------------------------------------------------------------------------- 1 | /elm-stuff/ 2 | /index.html 3 | -------------------------------------------------------------------------------- /examples/AnimalExample.elm: -------------------------------------------------------------------------------- 1 | module AnimalExample exposing (Animal(..), debugControl, view, viewAnimal) 2 | 3 | import Debug.Control exposing (Control, choice, list, map, string, value, values) 4 | import Html exposing (Html) 5 | import Html.Attributes as Html exposing (style) 6 | import String 7 | 8 | 9 | type Animal 10 | = Monkey 11 | | Giraffe 12 | | Eagle 13 | | Chimera (List Animal) 14 | | CustomAnimal String 15 | 16 | 17 | debugControl : Control (Maybe Animal) 18 | debugControl = 19 | let 20 | basicAnimal = 21 | values Debug.toString [ Monkey, Giraffe, Eagle ] 22 | in 23 | choice 24 | [ ( "Animal", map Just basicAnimal ) 25 | , ( "Chimera", map (Just << Chimera) (list basicAnimal) ) 26 | , ( "Custom", map (Just << CustomAnimal) (string "Zebra") ) 27 | , ( "Nothing", value Nothing ) 28 | ] 29 | 30 | 31 | viewAnimal : Int -> Maybe Animal -> Html msg 32 | viewAnimal size animal = 33 | let 34 | svg url = 35 | Html.img 36 | [ Html.style "width" (String.fromInt size ++ "px") 37 | , Html.style "height" (String.fromInt size ++ "px") 38 | , Html.style "overflow" "hidden" 39 | , Html.style "vertical-align" "bottom" 40 | , Html.src url 41 | , Html.width size 42 | ] 43 | [] 44 | 45 | letters background color string = 46 | Html.div 47 | [ Html.style "width" (String.fromInt size ++ "px") 48 | , Html.style "height" (String.fromInt size ++ "px") 49 | , Html.style "background-color" background 50 | , Html.style "color" color 51 | , Html.style "overflow" "hidden" 52 | , Html.style "text-overflow" "ellipsis" 53 | , Html.style "line-height" (String.fromInt size ++ "px") 54 | , Html.style "text-align" "center" 55 | , Html.style "font-family" "sans-serif" 56 | ] 57 | [ Html.text string ] 58 | in 59 | case animal of 60 | Just Monkey -> 61 | svg "monkey.svg" 62 | 63 | Just Giraffe -> 64 | svg "giraffe.svg" 65 | 66 | Just Eagle -> 67 | svg "eagle.svg" 68 | 69 | Just (CustomAnimal name) -> 70 | name 71 | |> String.split " " 72 | |> List.map (String.left 1) 73 | |> String.join "" 74 | |> String.toUpper 75 | |> letters "pink" "black" 76 | 77 | Just (Chimera parts) -> 78 | let 79 | scale = 80 | List.length parts 81 | |> toFloat 82 | |> sqrt 83 | |> ceiling 84 | in 85 | Html.div 86 | [ Html.style "width" (String.fromInt size ++ "px") 87 | , Html.style "height" (String.fromInt size ++ "px") 88 | , Html.style "background-color" "lightgreen" 89 | , Html.style "line-height" "0" 90 | ] 91 | (List.map (Just >> viewAnimal (size // scale)) parts) 92 | 93 | Nothing -> 94 | letters "lightgray" "gray" "N/A" 95 | 96 | 97 | view : Control (Maybe Animal) -> Html (Control (Maybe Animal)) 98 | view control = 99 | let 100 | h title = 101 | Html.h2 [] [ Html.text title ] 102 | 103 | showData data = 104 | Html.table [] 105 | [ Html.tr [] 106 | [ Html.td [] [ viewAnimal 50 data ] 107 | , Html.td [] 108 | [ Html.code 109 | [ style "word-break" "break-all" ] 110 | [ Html.text (Debug.toString data) ] 111 | ] 112 | ] 113 | ] 114 | in 115 | Html.div [] 116 | [ h "Example data structure" 117 | , Html.pre [] 118 | [ Html.text """type Animal 119 | = Monkey 120 | | Giraffe 121 | | Eagle 122 | | Chimera (List Animal) 123 | | CustomAnimal String""" 124 | ] 125 | , h "Interactive control" 126 | , Debug.Control.view identity control 127 | , showData (Debug.Control.currentValue control) 128 | , h "All possible values" 129 | , List.map showData (Debug.Control.allValues control) 130 | |> Html.div [] 131 | , Html.hr [] [] 132 | , Html.a [ Html.href "https://github.com/avh4/elm-debug-controls/blob/master/examples/LICENSE.md#images" ] 133 | [ Html.text "Image credits" ] 134 | ] 135 | -------------------------------------------------------------------------------- /examples/DropboxExample.elm: -------------------------------------------------------------------------------- 1 | module DropboxExample exposing (Model, Msg, init, update, view) 2 | 3 | import Debug.Control as Control exposing (Control) 4 | import Html exposing (..) 5 | import Time 6 | 7 | 8 | type alias Model = 9 | { download : Control DownloadRequest 10 | , upload : Control UploadRequest 11 | } 12 | 13 | 14 | type alias DownloadRequest = 15 | { path : String 16 | } 17 | 18 | 19 | type WriteMode 20 | = Add 21 | | Overwrite 22 | | Update String 23 | 24 | 25 | type alias UploadRequest = 26 | { path : String 27 | , mode : WriteMode 28 | , autorename : Bool 29 | , clientModified : Maybe Time.Posix 30 | , mute : Bool 31 | , content : String 32 | } 33 | 34 | 35 | init : Model 36 | init = 37 | { download = 38 | Control.record DownloadRequest 39 | |> Control.field "path" (Control.string "/demo.txt") 40 | , upload = 41 | Control.record UploadRequest 42 | |> Control.field "path" (Control.string "/demo.txt") 43 | |> Control.field "mode" 44 | (Control.choice 45 | [ ( "Add", Control.value Add ) 46 | , ( "Overwrite", Control.value Overwrite ) 47 | , ( "Update rev", Control.map Update <| Control.string "123abcdef" ) 48 | ] 49 | ) 50 | |> Control.field "autorename" (Control.bool False) 51 | |> Control.field "clientModified" 52 | (Control.maybe False <| Control.date Time.utc <| Time.millisToPosix 0) 53 | |> Control.field "mute" (Control.bool False) 54 | |> Control.field "content" 55 | (Control.stringTextarea 56 | """I do much wonder that one man, seeing how much 57 | another man is a fool when he dedicates his 58 | behaviors to love, will, after he hath laughed at 59 | such shallow follies in others, become the argument 60 | of his own scorn by failing in love: and such a man 61 | is Claudio. I have known when there was no music 62 | with him but the drum and the fife; and now had he 63 | rather hear the tabour and the pipe: I have known 64 | when he would have walked ten mile a-foot to see a 65 | good armour; and now will he lie ten nights awake, 66 | carving the fashion of a new doublet. 67 | """ 68 | ) 69 | } 70 | 71 | 72 | type Msg 73 | = DownloadChange (Control DownloadRequest) 74 | | UploadChange (Control UploadRequest) 75 | 76 | 77 | update : Msg -> Model -> Model 78 | update msg model = 79 | case msg of 80 | DownloadChange download -> 81 | { model | download = download } 82 | 83 | UploadChange upload -> 84 | { model | upload = upload } 85 | 86 | 87 | view : Model -> Html Msg 88 | view model = 89 | Html.div [] 90 | [ h2 [] [ text "Download" ] 91 | , p [] 92 | [ text "We have the following " 93 | , code [] [ text "DownloadRequest" ] 94 | , text " data type:" 95 | ] 96 | , pre [] 97 | [ text """type alias DownloadRequest = 98 | { path : String 99 | }""" 100 | ] 101 | , p [] [ text "An interactive control can be created with the following code:" ] 102 | , pre [] [ text """import Debug.Control exposing (field, record, string) 103 | 104 | record DownloadRequest 105 | |> field "path" (string "/demo.txt")""" ] 106 | , Control.view DownloadChange model.download 107 | , h2 [] [ text "Upload" ] 108 | , p [] 109 | [ text "We have the following " 110 | , code [] [ text "DownloadRequest" ] 111 | , text " data type:" 112 | ] 113 | , pre [] 114 | [ text """type alias UploadRequest = 115 | { path : String 116 | , mode : WriteMode 117 | , autorename : Bool 118 | , clientModified : Maybe Time.Posix 119 | , mute : Bool 120 | , content : String 121 | } 122 | 123 | type WriteMode 124 | = Add 125 | | Overwrite 126 | | Update String""" 127 | ] 128 | , p [] [ text "An interactive control can be created with the following code:" ] 129 | , pre [] [ text """import Debug.Control exposing (bool, choice, field, map, record, string, value) 130 | 131 | record UploadRequest 132 | |> field "path" (string "/demo.txt") 133 | |> field "mode" 134 | (choice 135 | [ ( "Add", value Add ) 136 | , ( "Overwrite", value Overwrite ) 137 | , ( "Update rev", map Update <| string "123abcdef" ) 138 | ] 139 | ) 140 | |> field "autorename" (bool False) 141 | |> field "clientModified" 142 | (maybe False <| date Tim.utc <| Time.millisToPosix 0) 143 | |> field "mute" (bool False) 144 | |> field "content" 145 | (Control.stringTextarea 146 | \"\"\"I do much wonder that one man, seeing how much 147 | another man is a fool when he dedicates his 148 | behaviors to love, will, after he hath laughed at 149 | such shallow follies in others, become the argument 150 | of his own scorn by failing in love: and such a man 151 | is Claudio. I have known when there was no music 152 | with him but the drum and the fife; and now had he 153 | rather hear the tabour and the pipe: I have known 154 | when he would have walked ten mile a-foot to see a 155 | good armour; and now will he lie ten nights awake, 156 | carving the fashion of a new doublet. 157 | \"\"\" 158 | ) 159 | """ ] 160 | , Control.view UploadChange model.upload 161 | ] 162 | -------------------------------------------------------------------------------- /examples/LICENSE.md: -------------------------------------------------------------------------------- 1 | 2 | ## Images 3 | 4 | License: https://openclipart.org/share 5 | 6 | Unlimited Commercial Use 7 | 8 | We try to make it clear that you may use all clipart from Openclipart even for [unlimited commercial use](https://openclipart.org/unlimited-commercial-use-clipart). We believe that giving away our images is a great way to share with the world our talents and that will come back around in a better form. 9 | 10 | May I Use Openclipart for? 11 | 12 | We put together a [small chart of as many possibilities and questions](https://openclipart.org/may-clipart-be-used-comparison) we have heard from people asking how they may use Openclipart. If you have an additional question, please email love@openclipart.org. 13 | 14 | All Clipart are Released into the Public Domain. 15 | 16 | Each artist at Openclipart [releases all rights](http://creativecommons.org/publicdomain/zero/1.0/) to the images they share at Openclipart. The reason is so that there is [no friction](http://creativecommons.org/publicdomain/zero/1.0/) in using and sharing images authors make available at this website so that each artist might also receive the same benefit in using other artists clipart totally for any possible reason. 17 | 18 | Images from: 19 | - giraffe.svg https://openclipart.org/detail/17628/cartoon-giraffe 20 | - eagle.svg https://openclipart.org/detail/98821/eagle 21 | - monkey.svg: https://openclipart.org/detail/14513/monkey-head 22 | -------------------------------------------------------------------------------- /examples/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (Model, Msg(..), WhichExample(..), choiceControl, initialModel, main, stringControl, update, view) 2 | 3 | import AnimalExample 4 | import BeautifulExample 5 | import Color 6 | import Debug.Control exposing (Control, choice, list, map, string, value, values) 7 | import DropboxExample 8 | import Html exposing (..) 9 | import Html.Events exposing (onClick) 10 | import RecursionExample 11 | 12 | 13 | stringControl : Control String 14 | stringControl = 15 | string "default value" 16 | 17 | 18 | choiceControl : Control Bool 19 | choiceControl = 20 | choice 21 | [ ( "YES", value True ) 22 | , ( "NO", value False ) 23 | ] 24 | 25 | 26 | type WhichExample 27 | = Animal 28 | | Dropbox 29 | | SimpleControls 30 | | RecursionExample 31 | 32 | 33 | type alias Model = 34 | { which : WhichExample 35 | , animal : Control (Maybe AnimalExample.Animal) 36 | , dropbox : DropboxExample.Model 37 | , choice : Control Bool 38 | , string : Control String 39 | , recursionExample : Control RecursionExample.RecursiveType 40 | } 41 | 42 | 43 | initialModel : Model 44 | initialModel = 45 | { which = Dropbox 46 | , animal = AnimalExample.debugControl 47 | , dropbox = DropboxExample.init 48 | , choice = choiceControl 49 | , string = stringControl 50 | , recursionExample = RecursionExample.init 51 | } 52 | 53 | 54 | type Msg 55 | = SwitchTo WhichExample 56 | | ChangeAnimal (Control (Maybe AnimalExample.Animal)) 57 | | DropboxMsg DropboxExample.Msg 58 | | ChangeChoice (Control Bool) 59 | | ChangeString (Control String) 60 | | ChangeRecursiveChoice (Control RecursionExample.RecursiveType) 61 | 62 | 63 | update : Msg -> Model -> Model 64 | update msg model = 65 | case msg of 66 | SwitchTo which -> 67 | { model | which = which } 68 | 69 | ChangeAnimal animal -> 70 | { model | animal = animal } 71 | 72 | DropboxMsg dropboxMsg -> 73 | { model | dropbox = DropboxExample.update dropboxMsg model.dropbox } 74 | 75 | ChangeChoice choice -> 76 | { model | choice = choice } 77 | 78 | ChangeString string -> 79 | { model | string = string } 80 | 81 | ChangeRecursiveChoice choice -> 82 | { model | recursionExample = choice } 83 | 84 | 85 | view : Model -> Html Msg 86 | view model = 87 | div [] 88 | [ button [ onClick (SwitchTo Dropbox) ] [ text "Records example (Upload/Download)" ] 89 | , br [] [] 90 | , button [ onClick (SwitchTo Animal) ] [ text "Union type example (Animal)" ] 91 | , br [] [] 92 | , button [ onClick (SwitchTo SimpleControls) ] [ text "Simple controls" ] 93 | , br [] [] 94 | , button [ onClick (SwitchTo RecursionExample) ] [ text "Recursion example" ] 95 | , br [] [] 96 | , case model.which of 97 | Animal -> 98 | AnimalExample.view model.animal 99 | |> Html.map ChangeAnimal 100 | 101 | Dropbox -> 102 | DropboxExample.view model.dropbox 103 | |> Html.map DropboxMsg 104 | 105 | SimpleControls -> 106 | div [] 107 | [ h3 [] [ text "choice" ] 108 | , Debug.Control.view ChangeChoice model.choice 109 | , h3 [] [ text "string" ] 110 | , Debug.Control.view ChangeString model.string 111 | ] 112 | 113 | RecursionExample -> 114 | RecursionExample.view model.recursionExample 115 | |> Html.map ChangeRecursiveChoice 116 | ] 117 | 118 | 119 | main : Program () Model Msg 120 | main = 121 | BeautifulExample.sandbox 122 | { title = "elm-debug-controls" 123 | , details = Just """This package helps you easily create interactive and exhaustive views of complex data structures.""" 124 | , color = Just Color.brown 125 | , maxWidth = 600 126 | , githubUrl = Just "https://github.com/avh4/elm-debug-controls" 127 | , documentationUrl = Just "http://package.elm-lang.org/packages/avh4/elm-debug-controls/latest" 128 | } 129 | { init = initialModel 130 | , update = update 131 | , view = view 132 | } 133 | -------------------------------------------------------------------------------- /examples/RecursionExample.elm: -------------------------------------------------------------------------------- 1 | module RecursionExample exposing (RecursiveType, init, view) 2 | 3 | import Debug.Control exposing (Control, choice, lazy, list, map, string, value, values) 4 | import Html exposing (Html) 5 | import Html.Attributes as Html exposing (style) 6 | import String 7 | 8 | 9 | type RecursiveType 10 | = RecursiveType (Maybe RecursiveType) 11 | 12 | 13 | init : Control RecursiveType 14 | init = 15 | choice 16 | [ ( "No child", value Nothing ) 17 | , ( "child", lazy (\() -> init) |> map Just ) 18 | ] 19 | |> map RecursiveType 20 | 21 | 22 | view : Control RecursiveType -> Html (Control RecursiveType) 23 | view control = 24 | let 25 | h title = 26 | Html.h2 [] [ Html.text title ] 27 | in 28 | Html.div [] 29 | [ h "Recursively-defined values" 30 | , Debug.Control.view identity control 31 | ] 32 | -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | ".", 5 | "../src" 6 | ], 7 | "elm-version": "0.19.1", 8 | "dependencies": { 9 | "direct": { 10 | "avh4/elm-beautiful-example": "2.0.1", 11 | "avh4/elm-color": "1.0.0", 12 | "elm/core": "1.0.5", 13 | "elm/html": "1.0.0", 14 | "elm/json": "1.1.3", 15 | "elm/time": "1.0.0", 16 | "justinmimbs/time-extra": "1.1.1" 17 | }, 18 | "indirect": { 19 | "elm/browser": "1.0.2", 20 | "elm/parser": "1.1.0", 21 | "elm/svg": "1.0.1", 22 | "elm/url": "1.0.0", 23 | "elm/virtual-dom": "1.0.3", 24 | "justinmimbs/date": "4.0.1" 25 | } 26 | }, 27 | "test-dependencies": { 28 | "direct": {}, 29 | "indirect": {} 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /examples/giraffe.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/monkey.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 248 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "scripts": { 3 | "test": "elm make && elm-test && npm run-script build-example && elm make --docs=documentation.json && npm run-script check && elm diff", 4 | "build-example": "(cd examples && elm make Main.elm)", 5 | "check": "elm-format --validate .", 6 | "build-site": "mkdir -p docs && cp examples/*.svg docs/ && npm run-script build-example && cp examples/index.html docs/" 7 | }, 8 | "devDependencies": { 9 | "elm": "^0.19.1-5", 10 | "elm-format": "^0.8.5", 11 | "elm-test": "^0.19.1-revision10" 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /screenshot.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/avh4/elm-debug-controls/a0245e506f9bdce81e4313d9503b1b972a54cae3/screenshot.gif -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? import { } }: 2 | 3 | pkgs.mkShell { 4 | buildInputs = with pkgs; [ nodejs nodePackages.npm-check-updates nixfmt ]; 5 | } 6 | -------------------------------------------------------------------------------- /src/Debug/Control.elm: -------------------------------------------------------------------------------- 1 | module Debug.Control exposing 2 | ( Control 3 | , value 4 | , bool, string, stringTextarea, date 5 | , values, maybe, choice, list, record, field 6 | , map 7 | , view, currentValue, allValues 8 | , lazy 9 | ) 10 | 11 | {-| Create interactive controls for complex data structures. 12 | 13 | @docs Control 14 | @docs value 15 | @docs bool, string, stringTextarea, date 16 | @docs values, maybe, choice, list, record, field 17 | @docs map 18 | 19 | @docs view, currentValue, allValues 20 | @docs lazy 21 | 22 | -} 23 | 24 | import Html exposing (Html) 25 | import Html.Attributes 26 | import Html.Events 27 | import Json.Decode 28 | import String 29 | import Time 30 | import Time.Extra 31 | 32 | 33 | {-| An interactive control that produces a value `a`. 34 | -} 35 | type Control a 36 | = Control 37 | { currentValue : () -> a 38 | , allValues : () -> List a 39 | , view : () -> ControlView a 40 | } 41 | 42 | 43 | type ControlView a 44 | = NoView 45 | | SingleView (Html (Control a)) 46 | | FieldViews (List ( String, Html (Control a) )) 47 | 48 | 49 | {-| A `Control` that has a static value (and no UI). 50 | -} 51 | value : a -> Control a 52 | value initial = 53 | Control 54 | { currentValue = \() -> initial 55 | , allValues = \() -> [ initial ] 56 | , view = \() -> NoView 57 | } 58 | 59 | 60 | {-| A `Control` that chooses between a list of values with a dropdown UI. 61 | 62 | The first value will be the initial value. 63 | 64 | -} 65 | values : (a -> String) -> List a -> Control a 66 | values toString choices = 67 | choice (List.map (\x -> ( toString x, value x )) choices) 68 | 69 | 70 | {-| A `Control` that wraps another control in a `Maybe`, which a checkbox UI. 71 | 72 | The `Bool` parameter is the initial value, where `False` is `Nothing`, 73 | and `True` is `Just` with the value of the nested control. 74 | 75 | -} 76 | maybe : Bool -> Control a -> Control (Maybe a) 77 | maybe isJust (Control control) = 78 | Control 79 | { currentValue = 80 | \() -> 81 | if isJust then 82 | Just (control.currentValue ()) 83 | 84 | else 85 | Nothing 86 | , allValues = 87 | \() -> 88 | Nothing 89 | :: List.map Just (control.allValues ()) 90 | , view = 91 | \() -> 92 | SingleView <| 93 | Html.span 94 | [ Html.Attributes.style "white-space" "nowrap" 95 | ] 96 | [ Html.input 97 | [ Html.Attributes.type_ "checkbox" 98 | , Html.Events.onCheck (\a -> maybe a (Control control)) 99 | , Html.Attributes.checked isJust 100 | ] 101 | [] 102 | , Html.text " " 103 | , if isJust then 104 | view_ (maybe isJust) (Control control) 105 | 106 | else 107 | Html.text "Nothing" 108 | ] 109 | } 110 | 111 | 112 | {-| A `Control` that toggles a `Bool` with a checkbox UI. 113 | -} 114 | bool : Bool -> Control Bool 115 | bool initialValue = 116 | Control 117 | { currentValue = \() -> initialValue 118 | , allValues = 119 | \() -> 120 | [ initialValue 121 | , not initialValue 122 | ] 123 | , view = 124 | \() -> 125 | SingleView <| 126 | Html.span [] 127 | [ Html.input 128 | [ Html.Attributes.type_ "checkbox" 129 | , Html.Events.onCheck bool 130 | , Html.Attributes.checked initialValue 131 | ] 132 | [] 133 | , Html.text " " 134 | , case initialValue of 135 | True -> 136 | Html.text "True" 137 | 138 | False -> 139 | Html.text "False" 140 | ] 141 | } 142 | 143 | 144 | {-| A `Control` that allows text input. 145 | -} 146 | string : String -> Control String 147 | string initialValue = 148 | Control 149 | { currentValue = \() -> initialValue 150 | , allValues = 151 | \() -> 152 | [ initialValue 153 | , "" 154 | , "short" 155 | , "Longwordyesverylongwithnospacessupercalifragilisticexpialidocious" 156 | , "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." 157 | ] 158 | , view = 159 | \() -> 160 | SingleView <| 161 | Html.input 162 | [ Html.Attributes.value initialValue 163 | , Html.Events.onInput string 164 | ] 165 | [] 166 | } 167 | 168 | 169 | {-| A `Control` that allows multiline text input. 170 | -} 171 | stringTextarea : String -> Control String 172 | stringTextarea initialValue = 173 | Control 174 | { currentValue = \() -> initialValue 175 | , allValues = 176 | \() -> 177 | [ initialValue 178 | , "" 179 | , "short" 180 | , "Longwordyesverylongwithnospacessupercalifragilisticexpialidocious" 181 | , """ 182 | Long text lorem ipsum dolor sit amet, consectetur adipiscing elit, 183 | sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. 184 | 185 | Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris 186 | nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in 187 | reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. 188 | Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum. 189 | """ 190 | ] 191 | , view = 192 | \() -> 193 | SingleView <| 194 | Html.textarea 195 | [ Html.Attributes.value initialValue 196 | , Html.Events.onInput stringTextarea 197 | ] 198 | [] 199 | } 200 | 201 | 202 | {-| A `Control` that allows a date and time input using the browser's date picker UI. 203 | -} 204 | date : Time.Zone -> Time.Posix -> Control Time.Posix 205 | date zone initialValue = 206 | let 207 | initial = 208 | Time.Extra.posixToParts zone initialValue 209 | 210 | initialDateTime : String 211 | initialDateTime = 212 | String.fromInt initial.year 213 | ++ "-" 214 | ++ twoDigitMonth initial.month 215 | ++ "-" 216 | ++ twoDigit initial.day 217 | ++ "T" 218 | ++ twoDigit initial.hour 219 | ++ ":" 220 | ++ twoDigit initial.minute 221 | in 222 | dateInputField initialDateTime 223 | |> map (toPosix zone >> Maybe.withDefault initialValue) 224 | 225 | 226 | toPosix : Time.Zone -> String -> Maybe Time.Posix 227 | toPosix zone time = 228 | case String.split "-" time of 229 | yearStr :: monthStr :: remainder :: [] -> 230 | case String.split "T" remainder of 231 | dayStr :: rem :: [] -> 232 | case String.split ":" "rem" of 233 | hourStr :: minuteStr :: [] -> 234 | Maybe.map5 235 | (\year month day hour minute -> 236 | Time.Extra.partsToPosix zone 237 | { year = year 238 | , month = month 239 | , day = day 240 | , hour = hour 241 | , minute = minute 242 | , second = 0 243 | , millisecond = 0 244 | } 245 | ) 246 | (String.toInt yearStr) 247 | (monthFromStr monthStr) 248 | (String.toInt dayStr) 249 | (String.toInt hourStr) 250 | (String.toInt minuteStr) 251 | 252 | _ -> 253 | Nothing 254 | 255 | _ -> 256 | Nothing 257 | 258 | _ -> 259 | Nothing 260 | 261 | 262 | monthFromStr : String -> Maybe Time.Month 263 | monthFromStr monthStr = 264 | case monthStr of 265 | "01" -> 266 | Just Time.Jan 267 | 268 | "02" -> 269 | Just Time.Feb 270 | 271 | "03" -> 272 | Just Time.Mar 273 | 274 | "04" -> 275 | Just Time.Apr 276 | 277 | "05" -> 278 | Just Time.May 279 | 280 | "06" -> 281 | Just Time.Jun 282 | 283 | "07" -> 284 | Just Time.Jul 285 | 286 | "08" -> 287 | Just Time.Aug 288 | 289 | "09" -> 290 | Just Time.Sep 291 | 292 | "10" -> 293 | Just Time.Oct 294 | 295 | "11" -> 296 | Just Time.Nov 297 | 298 | "12" -> 299 | Just Time.Dec 300 | 301 | _ -> 302 | Nothing 303 | 304 | 305 | twoDigitMonth : Time.Month -> String 306 | twoDigitMonth month = 307 | case month of 308 | Time.Jan -> 309 | "01" 310 | 311 | Time.Feb -> 312 | "02" 313 | 314 | Time.Mar -> 315 | "03" 316 | 317 | Time.Apr -> 318 | "04" 319 | 320 | Time.May -> 321 | "05" 322 | 323 | Time.Jun -> 324 | "06" 325 | 326 | Time.Jul -> 327 | "07" 328 | 329 | Time.Aug -> 330 | "08" 331 | 332 | Time.Sep -> 333 | "09" 334 | 335 | Time.Oct -> 336 | "10" 337 | 338 | Time.Nov -> 339 | "11" 340 | 341 | Time.Dec -> 342 | "12" 343 | 344 | 345 | twoDigit : Int -> String 346 | twoDigit val = 347 | if val < 10 then 348 | "0" ++ String.fromInt val 349 | 350 | else 351 | String.fromInt val 352 | 353 | 354 | dateInputField : String -> Control String 355 | dateInputField initialValue = 356 | Control 357 | { currentValue = \() -> initialValue 358 | , allValues = \() -> [ initialValue ] -- TODO 359 | , view = 360 | \() -> 361 | SingleView <| 362 | Html.input 363 | [ Html.Attributes.type_ "datetime-local" 364 | , Html.Attributes.pattern "[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}" 365 | , Html.Attributes.attribute "value" initialValue 366 | , Html.Events.onInput dateInputField 367 | ] 368 | [] 369 | } 370 | 371 | 372 | {-| A `Control` that chooses between a list of nested controls. 373 | 374 | This will crash if you provide an empty list. 375 | 376 | The first entry will be the initial value. 377 | 378 | -} 379 | choice : List ( String, Control a ) -> Control a 380 | choice choices = 381 | case choices of 382 | [] -> 383 | -- Debug.crash "No choices given" 384 | choice choices 385 | 386 | first :: rest -> 387 | choice_ [] first rest 388 | 389 | 390 | choice_ : 391 | List ( String, Control a ) 392 | -> ( String, Control a ) 393 | -> List ( String, Control a ) 394 | -> Control a 395 | choice_ left current right = 396 | Control 397 | { currentValue = \() -> current |> Tuple.second |> currentValue 398 | , allValues = 399 | \() -> 400 | (List.reverse left ++ [ current ] ++ right) 401 | |> List.map (Tuple.second >> allValues) 402 | |> List.concat 403 | , view = 404 | \() -> 405 | SingleView <| 406 | let 407 | option selected ( label, _ ) = 408 | Html.option 409 | [ Html.Attributes.selected selected ] 410 | [ Html.text label ] 411 | 412 | selectNew i = 413 | let 414 | all = 415 | List.reverse left 416 | ++ [ current ] 417 | ++ right 418 | 419 | left_ = 420 | all 421 | |> List.take i 422 | |> List.reverse 423 | 424 | current_ = 425 | all 426 | |> List.drop i 427 | |> List.head 428 | |> Maybe.withDefault current 429 | 430 | right_ = 431 | all 432 | |> List.drop (i + 1) 433 | in 434 | choice_ left_ current_ right_ 435 | 436 | updateChild new = 437 | choice_ left ( Tuple.first current, new ) right 438 | in 439 | Html.div [] 440 | [ Html.map selectNew <| 441 | Html.select 442 | [ Html.Events.on "change" (Json.Decode.at [ "target", "selectedIndex" ] Json.Decode.int) 443 | ] 444 | <| 445 | List.concat 446 | [ List.map (option False) <| List.reverse left 447 | , [ option True current ] 448 | , List.map (option False) right 449 | ] 450 | , view_ updateChild (Tuple.second current) 451 | ] 452 | } 453 | 454 | 455 | {-| A `Control` that provides a list of selected length. 456 | -} 457 | list : Control a -> Control (List a) 458 | list itemControl = 459 | list_ itemControl 1 0 10 460 | 461 | 462 | list_ : Control a -> Int -> Int -> Int -> Control (List a) 463 | list_ itemControl current min max = 464 | let 465 | makeList n = 466 | allValues itemControl 467 | |> List.repeat n 468 | |> List.concat 469 | |> List.take n 470 | in 471 | Control 472 | { currentValue = \() -> makeList current 473 | , allValues = 474 | \() -> 475 | [ 1, 0, 3 ] 476 | |> List.filter (\x -> x > min && x < max) 477 | |> (\a -> List.append a [ min, max ]) 478 | |> List.map makeList 479 | , view = 480 | \() -> 481 | SingleView <| 482 | let 483 | selectNew new = 484 | list_ itemControl new min max 485 | in 486 | Html.map 487 | (String.toInt 488 | >> Maybe.withDefault current 489 | >> selectNew 490 | ) 491 | <| 492 | Html.label [] 493 | [ Html.text "" 494 | , Html.input 495 | [ Html.Attributes.type_ "range" 496 | , Html.Attributes.min <| String.fromInt min 497 | , Html.Attributes.max <| String.fromInt max 498 | , Html.Attributes.step <| String.fromInt 1 499 | , Html.Attributes.attribute "value" <| String.fromInt current 500 | , Html.Events.on "input" Html.Events.targetValue 501 | ] 502 | [] 503 | ] 504 | } 505 | 506 | 507 | {-| Create a `Control` representing a record with multiple fields. 508 | 509 | This uses an API similar to [elm-decode-pipeline](http://package.elm-lang.org/packages/NoRedInk/elm-decode-pipeline/latest). 510 | 511 | You will use this with `field`. 512 | 513 | import Debug.Control exposing (field, record, string) 514 | 515 | type alias Point = 516 | { x : String 517 | , y : String 518 | } 519 | 520 | pointControl : Control Point 521 | pointControl = 522 | record Point 523 | |> field "x" (string "initial x value") 524 | |> field "y" (string "initial y value") 525 | 526 | -} 527 | record : a -> Control a 528 | record fn = 529 | Control 530 | { currentValue = \() -> fn 531 | , allValues = \() -> [ fn ] 532 | , view = \() -> FieldViews [] 533 | } 534 | 535 | 536 | {-| Used with `record` to create a `Control` representing a record. 537 | 538 | See [`record`](#record). 539 | 540 | -} 541 | field : String -> Control a -> Control (a -> b) -> Control b 542 | field name (Control control) (Control pipeline) = 543 | Control 544 | { currentValue = \() -> pipeline.currentValue () (control.currentValue ()) 545 | , allValues = 546 | \() -> 547 | control.allValues () 548 | |> List.concatMap 549 | (\v -> 550 | List.map (\p -> p v) 551 | (pipeline.allValues ()) 552 | ) 553 | , view = 554 | \() -> 555 | let 556 | otherFields = 557 | case pipeline.view () of 558 | FieldViews fs -> 559 | List.map (Tuple.mapSecond (\x -> Html.map (field name (Control control)) x)) 560 | fs 561 | 562 | _ -> 563 | [] 564 | 565 | newView = 566 | view_ (\v -> field name v (Control pipeline)) (Control control) 567 | in 568 | FieldViews (( name, newView ) :: otherFields) 569 | } 570 | 571 | 572 | {-| Transform the value produced by a `Control`. 573 | -} 574 | map : (a -> b) -> Control a -> Control b 575 | map fn (Control a) = 576 | Control 577 | { currentValue = \() -> fn (a.currentValue ()) 578 | , allValues = mapAllValues fn a.allValues 579 | , view = \() -> mapView fn (a.view ()) 580 | } 581 | 582 | 583 | {-| Use lazy when working with recursive types: 584 | 585 | import Debug.Control as Control exposing (Control) 586 | 587 | type RecursiveType 588 | = RecursiveType (Maybe RecursiveType) 589 | 590 | recursiveTypeControl : Control RecursiveType 591 | recursiveTypeControl = 592 | Control.choice 593 | [ ( "No child", Control.value Nothing ) 594 | , ( "child", Control.lazy (\() -> recursiveTypeControl) |> Control.map Just ) 595 | ] 596 | |> Control.map RecursiveType 597 | 598 | -} 599 | lazy : (() -> Control a) -> Control a 600 | lazy fn = 601 | let 602 | unwrap (Control v) = 603 | v 604 | in 605 | Control 606 | { currentValue = \() -> (unwrap (fn ())).currentValue () 607 | , allValues = \() -> (unwrap (fn ())).allValues () 608 | , view = \() -> (unwrap (fn ())).view () 609 | } 610 | 611 | 612 | mapAllValues : (a -> b) -> (() -> List a) -> (() -> List b) 613 | mapAllValues fn allValues_ = 614 | \() -> List.map fn (allValues_ ()) 615 | 616 | 617 | mapView : (a -> b) -> ControlView a -> ControlView b 618 | mapView fn controlView = 619 | case controlView of 620 | NoView -> 621 | NoView 622 | 623 | SingleView v -> 624 | SingleView (Html.map (map fn) v) 625 | 626 | FieldViews fs -> 627 | FieldViews 628 | (List.map (Tuple.mapSecond (Html.map (map fn))) fs) 629 | 630 | 631 | {-| Gets the current value of a `Control`. 632 | -} 633 | currentValue : Control a -> a 634 | currentValue (Control c) = 635 | c.currentValue () 636 | 637 | 638 | {-| TODO: revise API 639 | -} 640 | allValues : Control a -> List a 641 | allValues (Control c) = 642 | c.allValues () 643 | 644 | 645 | {-| Renders the interactive UI for a `Control`. 646 | -} 647 | view : (Control a -> msg) -> Control a -> Html msg 648 | view msg (Control c) = 649 | Html.div [] 650 | [ view_ msg (Control c) 651 | ] 652 | 653 | 654 | view_ : (Control a -> msg) -> Control a -> Html msg 655 | view_ msg (Control c) = 656 | case c.view () of 657 | NoView -> 658 | Html.text "" 659 | 660 | SingleView v -> 661 | Html.map msg v 662 | 663 | FieldViews fs -> 664 | let 665 | fieldRow index ( name, fieldView ) = 666 | Html.label 667 | [ Html.Attributes.style "display" "table-row" 668 | , Html.Attributes.style "vertical-align" "text-top" 669 | ] 670 | [ Html.span 671 | [ Html.Attributes.style "display" "table-cell" 672 | ] 673 | [ Html.text 674 | (if index == 0 then 675 | "{" 676 | 677 | else 678 | "," 679 | ) 680 | ] 681 | , Html.span 682 | [ Html.Attributes.style "display" "table-cell" 683 | , Html.Attributes.style "text-align" "right" 684 | ] 685 | [ Html.text name ] 686 | , Html.span 687 | [ Html.Attributes.style "display" "table-cell" 688 | ] 689 | [ Html.text " = " ] 690 | , Html.div 691 | [ Html.Attributes.style "display" "table-cell" 692 | ] 693 | [ fieldView ] 694 | ] 695 | in 696 | List.concat 697 | [ fs 698 | |> List.reverse 699 | |> List.indexedMap fieldRow 700 | , [ Html.div 701 | [ Html.Attributes.style "display" "table-row" 702 | ] 703 | [ Html.div 704 | [ Html.Attributes.style "display" "table-cell" 705 | ] 706 | [ Html.text "}" ] 707 | ] 708 | ] 709 | ] 710 | |> Html.div 711 | [ Html.Attributes.style "display" "table" 712 | , Html.Attributes.style "border-spacing" "2px" 713 | ] 714 | |> Html.map msg 715 | -------------------------------------------------------------------------------- /tests/.gitignore: -------------------------------------------------------------------------------- 1 | /elm-stuff/ 2 | -------------------------------------------------------------------------------- /tests/Controls/ComplexChoiceTest.elm: -------------------------------------------------------------------------------- 1 | module Controls.ComplexChoiceTest exposing (all) 2 | 3 | import Debug.Control as Control 4 | import Expect 5 | import Html 6 | import Html.Attributes as Html 7 | import Test exposing (..) 8 | import Test.Html.Query as Query 9 | import Test.Html.Selector exposing (..) 10 | 11 | 12 | type Animal 13 | = Monkey 14 | | Giraffe 15 | 16 | 17 | maybeControls = 18 | Control.choice 19 | [ ( "Animal" 20 | , Control.map Just <| 21 | Control.choice 22 | [ ( "Monkey", Control.value Monkey ) 23 | , ( "Giraffe", Control.value Giraffe ) 24 | ] 25 | ) 26 | , ( "---", Control.value Nothing ) 27 | ] 28 | 29 | 30 | all : Test 31 | all = 32 | describe "Control.choice (complex)" 33 | [ test "initial value is the first choice" <| 34 | \() -> 35 | maybeControls 36 | |> Control.currentValue 37 | |> Expect.equal (Just Monkey) 38 | , test "Renders all options" <| 39 | \() -> 40 | maybeControls 41 | |> Control.view identity 42 | |> Query.fromHtml 43 | |> Expect.all 44 | [ Query.has [ tag "option", text "Animal" ] 45 | , Query.has [ tag "option", text "---" ] 46 | , Query.has [ tag "option", text "Monkey" ] 47 | , Query.has [ tag "option", text "Giraffe" ] 48 | ] 49 | , test "allValues" <| 50 | \() -> 51 | maybeControls 52 | |> Control.allValues 53 | |> Expect.equal 54 | [ Just Monkey 55 | , Just Giraffe 56 | , Nothing 57 | ] 58 | ] 59 | -------------------------------------------------------------------------------- /tests/Controls/DateTest.elm: -------------------------------------------------------------------------------- 1 | module Controls.DateTest exposing (all) 2 | 3 | import Debug.Control as Control 4 | import Expect 5 | import Html 6 | import Html.Attributes as Html 7 | import Test exposing (..) 8 | import Test.Html.Query as Query 9 | import Test.Html.Selector exposing (..) 10 | import Time 11 | import Time.Extra 12 | 13 | 14 | all : Test 15 | all = 16 | describe "Control.date" 17 | [ test "epoch initial value" <| 18 | \() -> 19 | Control.date Time.utc (Time.millisToPosix 0) 20 | |> Control.currentValue 21 | |> Expect.equal (Time.millisToPosix 0) 22 | , test "other initial value" <| 23 | \() -> 24 | Control.date Time.utc (Time.millisToPosix 1425744000000) 25 | |> Control.currentValue 26 | |> Expect.equal (Time.millisToPosix 1425744000000) 27 | ] 28 | -------------------------------------------------------------------------------- /tests/Controls/ListTest.elm: -------------------------------------------------------------------------------- 1 | module Controls.ListTest exposing (all) 2 | 3 | import Debug.Control as Control 4 | import Expect 5 | import Html 6 | import Html.Attributes as Html 7 | import Test exposing (..) 8 | 9 | 10 | listControl = 11 | Control.list <| Control.values Debug.toString [ "A", "B" ] 12 | 13 | 14 | all : Test 15 | all = 16 | describe "Control.list" 17 | [ test "initial value" <| 18 | \() -> 19 | listControl 20 | |> Control.currentValue 21 | |> Expect.equal [ "A" ] 22 | ] 23 | -------------------------------------------------------------------------------- /tests/Controls/RecursionTest.elm: -------------------------------------------------------------------------------- 1 | module Controls.RecursionTest exposing (all) 2 | 3 | import Debug.Control as Control exposing (Control) 4 | import Expect 5 | import Html 6 | import Html.Attributes as Html 7 | import Test exposing (..) 8 | import Test.Html.Query as Query 9 | import Test.Html.Selector exposing (..) 10 | 11 | 12 | type RecursiveType 13 | = RecursiveType (Maybe RecursiveType) 14 | 15 | 16 | controls : Control RecursiveType 17 | controls = 18 | Control.choice 19 | [ ( "No child", Control.value Nothing ) 20 | , ( "child", Control.lazy (\() -> controls) |> Control.map Just ) 21 | ] 22 | |> Control.map RecursiveType 23 | 24 | 25 | all : Test 26 | all = 27 | describe "Control.choice (complex)" 28 | [ test "Initially there is no child" <| 29 | \() -> 30 | controls 31 | |> Control.currentValue 32 | |> Expect.equal (RecursiveType Nothing) 33 | , test "Renders all options" <| 34 | \() -> 35 | controls 36 | |> Control.view identity 37 | |> Query.fromHtml 38 | |> Expect.all 39 | [ Query.has [ tag "option", text "No child" ] 40 | , Query.has [ tag "option", text "child" ] 41 | ] 42 | ] 43 | -------------------------------------------------------------------------------- /tests/Controls/SimpleChoiceTest.elm: -------------------------------------------------------------------------------- 1 | module Controls.SimpleChoiceTest exposing (all) 2 | 3 | import Debug.Control as Control 4 | import Expect 5 | import Html 6 | import Html.Attributes as Html 7 | import Test exposing (..) 8 | import Test.Html.Query as Query 9 | import Test.Html.Selector exposing (..) 10 | 11 | 12 | yesNoControls = 13 | Control.choice 14 | [ ( "YES", Control.value True ) 15 | , ( "NO", Control.value False ) 16 | ] 17 | 18 | 19 | all : Test 20 | all = 21 | describe "Control.choice" 22 | [ test "initial value is the first choice" <| 23 | \() -> 24 | yesNoControls 25 | |> Control.currentValue 26 | |> Expect.equal True 27 | , test "Renders all options" <| 28 | \() -> 29 | yesNoControls 30 | |> Control.view identity 31 | |> Query.fromHtml 32 | |> Expect.all 33 | [ Query.has [ tag "option", text "YES" ] 34 | , Query.has [ tag "option", text "NO" ] 35 | ] 36 | ] 37 | -------------------------------------------------------------------------------- /tests/Controls/StringTest.elm: -------------------------------------------------------------------------------- 1 | module Controls.StringTest exposing (all) 2 | 3 | import Debug.Control as Control 4 | import Expect 5 | import Html 6 | import Html.Attributes as Html 7 | import Test exposing (..) 8 | import Test.Html.Query as Query 9 | import Test.Html.Selector exposing (..) 10 | 11 | 12 | all : Test 13 | all = 14 | describe "Text" 15 | [ describe "Control.string" 16 | [ test "initial value" <| 17 | \() -> 18 | Control.string "default" 19 | |> Control.currentValue 20 | |> Expect.equal "default" 21 | , test "Renders all options" <| 22 | \() -> 23 | Control.string "default" 24 | |> Control.view identity 25 | |> Query.fromHtml 26 | |> Query.has [ tag "input", attribute (Html.value "default") ] 27 | ] 28 | , describe "Control.stringTextarea" 29 | [ test "initial value" <| 30 | \() -> 31 | Control.stringTextarea "long default" 32 | |> Control.currentValue 33 | |> Expect.equal "long default" 34 | , test "Renders all options" <| 35 | \() -> 36 | Control.stringTextarea "long default" 37 | |> Control.view identity 38 | |> Query.fromHtml 39 | |> Query.has [ tag "textarea", attribute (Html.value "long default") ] 40 | ] 41 | ] 42 | --------------------------------------------------------------------------------