This commit is contained in:
Keith Lazuka
Коммит
31c03081c1
|
|
@ -0,0 +1,6 @@
|
|||
elm-stuff/
|
||||
|
||||
# IntelliJ stuff
|
||||
.idea/
|
||||
elm-json-tree-view.iml
|
||||
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
MIT License
|
||||
|
||||
Copyright (c) Microsoft Corporation. All rights reserved.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
# Elm JSON Tree View
|
||||
|
||||
This library provides a JSON tree view. You feed it JSON, and it transforms it into
|
||||
interactive HTML.
|
||||
|
||||
Features:
|
||||
|
||||
- show JSON as a tree of HTML
|
||||
- expand/collapse nodes in the tree
|
||||
- expand/collapse the entire tree
|
||||
- select scalar values in the tree
|
||||
|
||||
## Usage
|
||||
|
||||
See the [docs](http://package.elm-lang.org/packages/Microsoft/elm-json-tree-view/latest)
|
||||
or look at the example app in the `example` directory.
|
||||
|
||||
But if you really insist on something super simple, here goes:
|
||||
```elm
|
||||
import JsonTree
|
||||
import Html exposing (text)
|
||||
|
||||
main =
|
||||
JsonTree.parseString """[1,2,3]"""
|
||||
|> Result.map (\tree -> JsonTree.view tree config JsonTree.defaultState)
|
||||
|> Result.withDefault (text "Failed to parse JSON")
|
||||
|
||||
config = { onSelect = Nothing, toMsg = always () }
|
||||
```
|
||||
|
||||
Note that the above example is only meant to give you a taste. It does not wire everything
|
||||
up, which means that some things will be broken (i.e. expand/collapse). See the
|
||||
[docs](http://package.elm-lang.org/packages/Microsoft/elm-json-tree-view/latest) and
|
||||
the example app for more details.
|
||||
|
||||
## Contributing
|
||||
|
||||
This project welcomes contributions and suggestions. Most contributions require you to
|
||||
agree to a Contributor License Agreement (CLA) declaring that you have the right to,
|
||||
and actually do, grant us the rights to use your contribution. For details, visit
|
||||
https://cla.microsoft.com.
|
||||
|
||||
When you submit a pull request, a CLA-bot will automatically determine whether you need
|
||||
to provide a CLA and decorate the PR appropriately (e.g., label, comment). Simply follow the
|
||||
instructions provided by the bot. You will only need to do this once across all repositories using our CLA.
|
||||
|
||||
This project has adopted the [Microsoft Open Source Code of Conduct](https://opensource.microsoft.com/codeofconduct/).
|
||||
For more information see the [Code of Conduct FAQ](https://opensource.microsoft.com/codeofconduct/faq/)
|
||||
or contact [opencode@microsoft.com](mailto:opencode@microsoft.com) with any additional questions or comments.
|
||||
|
||||
## License
|
||||
|
||||
MIT
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "Shows JSON data as an expandable HTML tree",
|
||||
"repository": "https://github.com/Microsoft/elm-json-tree-view.git",
|
||||
"license": "MIT",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": ["JsonTree"],
|
||||
"dependencies": {
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||
"jinjor/elm-inline-hover": "1.0.2 <= v < 2.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
# Distribution
|
||||
build/
|
||||
|
||||
# elm-package generated files
|
||||
elm-stuff
|
||||
|
||||
# elm-repl generated files
|
||||
repl-temp-*
|
||||
|
||||
# Dependency directories
|
||||
node_modules
|
||||
|
||||
# Desktop Services Store on macOS
|
||||
.DS_Store
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
# elm-json-tree-view example
|
||||
|
||||
## Build & Run
|
||||
|
||||
```bash
|
||||
cd example
|
||||
elm-make src/Main.elm
|
||||
open index.html
|
||||
```
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "Example demonstrating how to use elm-json-tree-view",
|
||||
"repository": "https://github.com/Microsoft/elm-json-tree-view.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"src",
|
||||
"../src"
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"dependencies": {
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||
"jinjor/elm-inline-hover": "1.0.2 <= v < 2.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
|
|
@ -0,0 +1,209 @@
|
|||
-- Copyright (c) Microsoft Corporation. All rights reserved.
|
||||
-- Licensed under the MIT License.
|
||||
|
||||
module Main exposing (..)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (checked, class, style, type_, value)
|
||||
import Html.Events exposing (onCheck, onClick, onInput)
|
||||
import JsonTree
|
||||
|
||||
|
||||
exampleJsonInput =
|
||||
"""
|
||||
{
|
||||
"name": "Arnold",
|
||||
"age": 70,
|
||||
"isStrong": true,
|
||||
"knownWeakness": null,
|
||||
"nicknames": ["Terminator", "The Governator"],
|
||||
"extra": {
|
||||
"foo": "bar"
|
||||
}
|
||||
}
|
||||
"""
|
||||
|
||||
|
||||
|
||||
---- MODEL ----
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ jsonInput : String
|
||||
, parseResult : Result String JsonTree.Node
|
||||
, treeState : JsonTree.State
|
||||
, clickToSelectEnabled : Bool
|
||||
, selections : List JsonTree.KeyPath
|
||||
}
|
||||
|
||||
|
||||
init : ( Model, Cmd Msg )
|
||||
init =
|
||||
( { jsonInput = exampleJsonInput
|
||||
, parseResult = JsonTree.parseString exampleJsonInput
|
||||
, treeState = JsonTree.defaultState
|
||||
, clickToSelectEnabled = False
|
||||
, selections = []
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
|
||||
---- UPDATE ----
|
||||
|
||||
|
||||
type Msg
|
||||
= SetJsonInput String
|
||||
| Parse
|
||||
| SetTreeViewState JsonTree.State
|
||||
| ExpandAll
|
||||
| CollapseAll
|
||||
| ToggleSelectionMode
|
||||
| Selected JsonTree.KeyPath
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
SetJsonInput string ->
|
||||
( { model | jsonInput = string }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Parse ->
|
||||
( { model | parseResult = JsonTree.parseString model.jsonInput }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
SetTreeViewState state ->
|
||||
( { model | treeState = state }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
ExpandAll ->
|
||||
( { model | treeState = JsonTree.expandAll model.treeState }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CollapseAll ->
|
||||
case model.parseResult of
|
||||
Ok rootNode ->
|
||||
( { model | treeState = JsonTree.collapseToDepth 1 rootNode model.treeState }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Err _ ->
|
||||
( model, Cmd.none )
|
||||
|
||||
ToggleSelectionMode ->
|
||||
( { model
|
||||
| clickToSelectEnabled = not model.clickToSelectEnabled
|
||||
, selections = []
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Selected keyPath ->
|
||||
( { model | selections = model.selections ++ [ keyPath ] }, Cmd.none )
|
||||
|
||||
|
||||
|
||||
---- VIEW ----
|
||||
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
div []
|
||||
[ h1 [] [ text "JSON Tree View Example" ]
|
||||
, viewInputArea model
|
||||
, hr [] []
|
||||
, viewJsonTree model
|
||||
, if model.clickToSelectEnabled then
|
||||
viewSelections model
|
||||
else
|
||||
text ""
|
||||
]
|
||||
|
||||
|
||||
viewInputArea : Model -> Html Msg
|
||||
viewInputArea model =
|
||||
div []
|
||||
[ h3 [] [ text "Raw JSON input:" ]
|
||||
, textarea
|
||||
[ value model.jsonInput
|
||||
, onInput SetJsonInput
|
||||
, style
|
||||
[ ( "width", "400px" )
|
||||
, ( "height", "200px" )
|
||||
, ( "font-size", "14px" )
|
||||
]
|
||||
]
|
||||
[]
|
||||
, div [] [ button [ onClick Parse ] [ text "Parse" ] ]
|
||||
]
|
||||
|
||||
|
||||
viewJsonTree : Model -> Html Msg
|
||||
viewJsonTree model =
|
||||
let
|
||||
toolbar =
|
||||
div []
|
||||
[ label []
|
||||
[ input
|
||||
[ type_ "checkbox"
|
||||
, onCheck (always ToggleSelectionMode)
|
||||
, checked model.clickToSelectEnabled
|
||||
]
|
||||
[]
|
||||
, text "Selection Mode"
|
||||
]
|
||||
, button [ onClick ExpandAll ] [ text "Expand All" ]
|
||||
, button [ onClick CollapseAll ] [ text "Collapse All" ]
|
||||
]
|
||||
|
||||
config allowSelection =
|
||||
{ onSelect =
|
||||
if allowSelection then
|
||||
Just Selected
|
||||
else
|
||||
Nothing
|
||||
, toMsg = SetTreeViewState
|
||||
}
|
||||
in
|
||||
div []
|
||||
[ h3 [] [ text "JSON Tree View" ]
|
||||
, toolbar
|
||||
, case model.parseResult of
|
||||
Ok rootNode ->
|
||||
JsonTree.view rootNode (config model.clickToSelectEnabled) model.treeState
|
||||
|
||||
Err e ->
|
||||
text ("Invalid JSON: " ++ e)
|
||||
]
|
||||
|
||||
|
||||
viewSelections : Model -> Html Msg
|
||||
viewSelections model =
|
||||
div []
|
||||
[ hr [] []
|
||||
, h3 [] [ text "Recently selected key-paths" ]
|
||||
, if List.isEmpty model.selections then
|
||||
text "No selections. Click any scalar value in the JSON tree view above to select it."
|
||||
else
|
||||
ul [] (List.map (\x -> li [] [ text x ]) model.selections)
|
||||
]
|
||||
|
||||
|
||||
|
||||
---- PROGRAM ----
|
||||
|
||||
|
||||
main : Program Never Model Msg
|
||||
main =
|
||||
Html.program
|
||||
{ view = view
|
||||
, init = init
|
||||
, update = update
|
||||
, subscriptions = always Sub.none
|
||||
}
|
||||
|
|
@ -0,0 +1,451 @@
|
|||
-- Copyright (c) Microsoft Corporation. All rights reserved.
|
||||
-- Licensed under the MIT License.
|
||||
|
||||
module JsonTree
|
||||
exposing
|
||||
( Node
|
||||
, TaggedValue(..)
|
||||
, KeyPath
|
||||
, Config
|
||||
, State
|
||||
, parseValue
|
||||
, parseString
|
||||
, view
|
||||
, defaultState
|
||||
, expandAll
|
||||
, collapseToDepth
|
||||
)
|
||||
|
||||
{-| This library provides a JSON tree view. You feed it JSON, and it transforms it into
|
||||
interactive HTML.
|
||||
|
||||
Features:
|
||||
|
||||
- show JSON as a tree of HTML
|
||||
- expand/collapse nodes in the tree
|
||||
- expand/collapse the entire tree
|
||||
- select scalar values in the tree
|
||||
|
||||
|
||||
# Basic Usage
|
||||
|
||||
@docs parseString, parseValue, view
|
||||
|
||||
|
||||
# Types
|
||||
|
||||
@docs Config, State, defaultState, Node, TaggedValue, KeyPath
|
||||
|
||||
|
||||
# Expand/Collapse
|
||||
|
||||
@docs expandAll, collapseToDepth
|
||||
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Html exposing (Attribute, Html, button, div, li, span, text, ul)
|
||||
import Html.Attributes exposing (class, id, style)
|
||||
import Html.Events exposing (onClick)
|
||||
import InlineHover exposing (hover)
|
||||
import Set exposing (Set)
|
||||
|
||||
|
||||
{-| A node in the tree
|
||||
-}
|
||||
type alias Node =
|
||||
{ value : TaggedValue
|
||||
, keyPath : KeyPath
|
||||
}
|
||||
|
||||
|
||||
{-| A tagged value
|
||||
-}
|
||||
type TaggedValue
|
||||
= TString String
|
||||
| TFloat Float
|
||||
| TBool Bool
|
||||
| TList (List Node)
|
||||
| TDict (Dict String Node)
|
||||
| TNull
|
||||
|
||||
|
||||
{-| The path to a piece of data in the tree.
|
||||
-}
|
||||
type alias KeyPath =
|
||||
String
|
||||
|
||||
|
||||
{-| Parse a JSON value as a tree.
|
||||
-}
|
||||
parseValue : Decode.Value -> Result String Node
|
||||
parseValue json =
|
||||
let
|
||||
rootKeyPath =
|
||||
""
|
||||
|
||||
decoder =
|
||||
Decode.map (annotate rootKeyPath) coreDecoder
|
||||
in
|
||||
Decode.decodeValue decoder json
|
||||
|
||||
|
||||
{-| Parse a JSON string as a tree.
|
||||
-}
|
||||
parseString : String -> Result String Node
|
||||
parseString string =
|
||||
Decode.decodeString Decode.value string
|
||||
|> Result.andThen parseValue
|
||||
|
||||
|
||||
coreDecoder : Decoder Node
|
||||
coreDecoder =
|
||||
let
|
||||
makeNode v =
|
||||
{ value = v, keyPath = "" }
|
||||
in
|
||||
Decode.oneOf
|
||||
[ Decode.map (makeNode << TString) Decode.string
|
||||
, Decode.map (makeNode << TFloat) Decode.float
|
||||
, Decode.map (makeNode << TBool) Decode.bool
|
||||
, Decode.map (makeNode << TList) (Decode.list (Decode.lazy (\_ -> coreDecoder)))
|
||||
, Decode.map (makeNode << TDict) (Decode.dict (Decode.lazy (\_ -> coreDecoder)))
|
||||
, Decode.null (makeNode TNull)
|
||||
]
|
||||
|
||||
|
||||
annotate : String -> Node -> Node
|
||||
annotate pathSoFar node =
|
||||
let
|
||||
annotateList index val =
|
||||
annotate (pathSoFar ++ "[" ++ toString index ++ "]") val
|
||||
|
||||
annotateDict fieldName val =
|
||||
annotate (pathSoFar ++ "." ++ fieldName) val
|
||||
in
|
||||
case node.value of
|
||||
TString _ ->
|
||||
{ node | keyPath = pathSoFar }
|
||||
|
||||
TFloat _ ->
|
||||
{ node | keyPath = pathSoFar }
|
||||
|
||||
TBool _ ->
|
||||
{ node | keyPath = pathSoFar }
|
||||
|
||||
TNull ->
|
||||
{ node | keyPath = pathSoFar }
|
||||
|
||||
TList children ->
|
||||
{ node
|
||||
| keyPath = pathSoFar
|
||||
, value = TList (List.indexedMap annotateList children)
|
||||
}
|
||||
|
||||
TDict dict ->
|
||||
{ node
|
||||
| keyPath = pathSoFar
|
||||
, value = TDict (Dict.map annotateDict dict)
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
{-| Show a JSON tree.
|
||||
-}
|
||||
view : Node -> Config msg -> State -> Html msg
|
||||
view node config state =
|
||||
div
|
||||
[ style css.root ]
|
||||
(viewNodeInternal 0 config node state)
|
||||
|
||||
|
||||
{-| Configuration of the JSON tree view. It describes how to map events in the tree view
|
||||
into events that your app understands.
|
||||
|
||||
Since the `Config` contains functions, it should never be held in your model. It should
|
||||
only appear in your `view` code.
|
||||
|
||||
`onSelect` should be set to `Nothing` for most users. However, if you want to make the
|
||||
tree's leaf nodes selectable, you should provide a function that takes the selected `KeyPath`
|
||||
and acts on it.
|
||||
|
||||
`toMsg` provides an updated `State` to your application which you should use to overwrite
|
||||
the previous state.
|
||||
|
||||
-}
|
||||
type alias Config msg =
|
||||
{ onSelect : Maybe (KeyPath -> msg)
|
||||
, toMsg : State -> msg
|
||||
}
|
||||
|
||||
|
||||
{-| The state of the JSON tree view. Note that this is just the runtime state needed to
|
||||
implement things like expand/collapse--it is *not* the tree data itself.
|
||||
|
||||
You should store the current state in your model.
|
||||
|
||||
-}
|
||||
type State
|
||||
= State (Set KeyPath)
|
||||
|
||||
|
||||
{-| Initial state where the entire tree is fully expanded.
|
||||
-}
|
||||
defaultState : State
|
||||
defaultState =
|
||||
stateFullyExpanded
|
||||
|
||||
|
||||
{-| Collapses any nodes deeper than `maxDepth`.
|
||||
-}
|
||||
collapseToDepth : Int -> Node -> State -> State
|
||||
collapseToDepth maxDepth tree _ =
|
||||
collapseToDepthHelp maxDepth 0 tree stateFullyExpanded
|
||||
|
||||
|
||||
collapseToDepthHelp : Int -> Int -> Node -> State -> State
|
||||
collapseToDepthHelp maxDepth currentDepth node state =
|
||||
let
|
||||
descend children =
|
||||
List.foldl
|
||||
(collapseToDepthHelp maxDepth (currentDepth + 1))
|
||||
(if currentDepth >= maxDepth then
|
||||
collapse node.keyPath state
|
||||
else
|
||||
state
|
||||
)
|
||||
children
|
||||
in
|
||||
case node.value of
|
||||
TString str ->
|
||||
state
|
||||
|
||||
TFloat x ->
|
||||
state
|
||||
|
||||
TBool bool ->
|
||||
state
|
||||
|
||||
TNull ->
|
||||
state
|
||||
|
||||
TList nodes ->
|
||||
descend nodes
|
||||
|
||||
TDict dict ->
|
||||
descend (Dict.values dict)
|
||||
|
||||
|
||||
{-| Expand all nodes
|
||||
-}
|
||||
expandAll : State -> State
|
||||
expandAll _ =
|
||||
stateFullyExpanded
|
||||
|
||||
|
||||
stateFullyExpanded : State
|
||||
stateFullyExpanded =
|
||||
State (Set.fromList [])
|
||||
|
||||
|
||||
|
||||
-- EXPAND/COLLAPSE --
|
||||
|
||||
|
||||
lazyStateChangeOnClick : (() -> State) -> (State -> msg) -> Attribute msg
|
||||
lazyStateChangeOnClick newStateThunk toMsg =
|
||||
{- This is semantically equivalent to `onClick (toMsg newState)`, but defers the computation
|
||||
of the new `State` until the event is delivered/decoded.
|
||||
-}
|
||||
let
|
||||
force =
|
||||
\thunk -> thunk ()
|
||||
in
|
||||
newStateThunk
|
||||
|> Decode.succeed
|
||||
|> Decode.map (force >> toMsg)
|
||||
|> Html.Events.on "click"
|
||||
|
||||
|
||||
expand : KeyPath -> State -> State
|
||||
expand keyPath ((State hiddenPaths) as state) =
|
||||
State (Set.remove keyPath hiddenPaths)
|
||||
|
||||
|
||||
collapse : KeyPath -> State -> State
|
||||
collapse keyPath ((State hiddenPaths) as state) =
|
||||
State (Set.insert keyPath hiddenPaths)
|
||||
|
||||
|
||||
isCollapsed : KeyPath -> State -> Bool
|
||||
isCollapsed keyPath ((State hiddenPaths) as state) =
|
||||
Set.member keyPath hiddenPaths
|
||||
|
||||
|
||||
viewNodeInternal : Int -> Config msg -> Node -> State -> List (Html msg)
|
||||
viewNodeInternal depth config node state =
|
||||
case node.value of
|
||||
TString str ->
|
||||
viewScalar css.string ("\"" ++ str ++ "\"") node config
|
||||
|
||||
TFloat x ->
|
||||
viewScalar css.number (toString x) node config
|
||||
|
||||
TBool bool ->
|
||||
viewScalar css.bool (toString bool) node config
|
||||
|
||||
TNull ->
|
||||
viewScalar css.null "null" node config
|
||||
|
||||
TList nodes ->
|
||||
viewArray depth nodes node.keyPath config state
|
||||
|
||||
TDict dict ->
|
||||
viewDict depth dict node.keyPath config state
|
||||
|
||||
|
||||
viewScalar : List ( String, String ) -> String -> Node -> Config msg -> List (Html msg)
|
||||
viewScalar someCss str node config =
|
||||
List.singleton <|
|
||||
case config.onSelect of
|
||||
Just onSelect ->
|
||||
hover css.selectable
|
||||
span
|
||||
[ style someCss
|
||||
, id node.keyPath
|
||||
, onClick (onSelect node.keyPath)
|
||||
]
|
||||
[ text str ]
|
||||
|
||||
Nothing ->
|
||||
span
|
||||
[ style someCss
|
||||
, id node.keyPath
|
||||
]
|
||||
[ text str ]
|
||||
|
||||
|
||||
viewCollapser : Int -> Config msg -> (() -> State) -> String -> Html msg
|
||||
viewCollapser depth config newStateThunk displayText =
|
||||
if depth == 0 then
|
||||
text ""
|
||||
else
|
||||
span
|
||||
[ style css.collapser
|
||||
, lazyStateChangeOnClick newStateThunk config.toMsg
|
||||
]
|
||||
[ text displayText ]
|
||||
|
||||
|
||||
viewExpandButton : Int -> KeyPath -> Config msg -> State -> Html msg
|
||||
viewExpandButton depth keyPath config state =
|
||||
viewCollapser depth config (\_ -> expand keyPath state) "+"
|
||||
|
||||
|
||||
viewCollapseButton : Int -> KeyPath -> Config msg -> State -> Html msg
|
||||
viewCollapseButton depth keyPath config state =
|
||||
viewCollapser depth config (\_ -> collapse keyPath state) "-"
|
||||
|
||||
|
||||
viewArray : Int -> List Node -> KeyPath -> Config msg -> State -> List (Html msg)
|
||||
viewArray depth nodes keyPath config state =
|
||||
let
|
||||
innerContent =
|
||||
if List.isEmpty nodes then
|
||||
[]
|
||||
else if isCollapsed keyPath state then
|
||||
[ viewExpandButton depth keyPath config state
|
||||
, text "…"
|
||||
]
|
||||
else
|
||||
[ viewCollapseButton depth keyPath config state
|
||||
, ul
|
||||
[ style css.ul ]
|
||||
(List.map viewListItem nodes)
|
||||
]
|
||||
|
||||
viewListItem node =
|
||||
li
|
||||
[ style css.li ]
|
||||
(List.append (viewNodeInternal (depth + 1) config node state) [ text "," ])
|
||||
in
|
||||
[ text "[" ] ++ innerContent ++ [ text "]" ]
|
||||
|
||||
|
||||
viewDict : Int -> Dict String Node -> KeyPath -> Config msg -> State -> List (Html msg)
|
||||
viewDict depth dict keyPath config state =
|
||||
let
|
||||
innerContent =
|
||||
if Dict.isEmpty dict then
|
||||
[]
|
||||
else if isCollapsed keyPath state then
|
||||
[ viewExpandButton depth keyPath config state
|
||||
, text "…"
|
||||
]
|
||||
else
|
||||
[ viewCollapseButton depth keyPath config state
|
||||
, ul
|
||||
[ style css.ul ]
|
||||
(List.map viewListItem (Dict.toList dict))
|
||||
]
|
||||
|
||||
viewListItem ( fieldName, node ) =
|
||||
li
|
||||
[ style css.li ]
|
||||
([ span [ style css.fieldName ] [ text fieldName ]
|
||||
, text ": "
|
||||
]
|
||||
++ (viewNodeInternal (depth + 1) config node state)
|
||||
++ [ text "," ]
|
||||
)
|
||||
in
|
||||
[ text "{" ] ++ innerContent ++ [ text "}" ]
|
||||
|
||||
|
||||
|
||||
-- STYLES
|
||||
|
||||
|
||||
css =
|
||||
{ root =
|
||||
[ ( "font-family", "monospace" )
|
||||
, ( "white-space", "pre" )
|
||||
]
|
||||
, ul =
|
||||
[ ( "list-style-type", "none" )
|
||||
, ( "margin-left", "26px" )
|
||||
, ( "padding-left", "0px" )
|
||||
]
|
||||
, li =
|
||||
[ ( "position", "relative" )
|
||||
]
|
||||
, collapser =
|
||||
[ ( "position", "absolute" )
|
||||
, ( "cursor", "pointer" )
|
||||
, ( "top", "1px" )
|
||||
, ( "left", "-15px" )
|
||||
]
|
||||
, fieldName =
|
||||
[ ( "font-weight", "bold" )
|
||||
]
|
||||
, string =
|
||||
[ ( "color", "green" )
|
||||
]
|
||||
, number =
|
||||
[ ( "color", "blue" )
|
||||
]
|
||||
, bool =
|
||||
[ ( "color", "firebrick" )
|
||||
]
|
||||
, null =
|
||||
[ ( "color", "gray" )
|
||||
]
|
||||
, selectable =
|
||||
[ ( "background-color", "#fafad2" )
|
||||
, ( "cursor", "pointer" )
|
||||
]
|
||||
}
|
||||
|
|
@ -0,0 +1,129 @@
|
|||
module Tests exposing (..)
|
||||
|
||||
import Dict
|
||||
import Expect exposing (Expectation)
|
||||
import Fuzz exposing (Fuzzer, int, list, string)
|
||||
import JsonTree exposing (Node, TaggedValue(..))
|
||||
import Test exposing (Test, describe, only, test)
|
||||
import Json.Encode as Encode
|
||||
|
||||
|
||||
suite : Test
|
||||
suite =
|
||||
describe "JsonTree parsing"
|
||||
[ test "parses strings" <|
|
||||
\_ ->
|
||||
JsonTree.parseValue (Encode.string "hi")
|
||||
|> Expect.equal (Ok (Node (TString "hi") ""))
|
||||
, test "parses numbers" <|
|
||||
\_ ->
|
||||
JsonTree.parseValue (Encode.float 3.14)
|
||||
|> Expect.equal (Ok (Node (TFloat 3.14) ""))
|
||||
, test "parses bools" <|
|
||||
\_ ->
|
||||
JsonTree.parseValue (Encode.bool True)
|
||||
|> Expect.equal (Ok (Node (TBool True) ""))
|
||||
, test "parses null" <|
|
||||
\_ ->
|
||||
JsonTree.parseValue Encode.null
|
||||
|> Expect.equal (Ok (Node TNull ""))
|
||||
, test "parses lists" <|
|
||||
\_ ->
|
||||
JsonTree.parseValue (Encode.list (List.map Encode.float [ 1, 2, 3 ]))
|
||||
|> Expect.equal
|
||||
(Ok
|
||||
{ value =
|
||||
TList
|
||||
[ Node (TFloat 1) "[0]"
|
||||
, Node (TFloat 2) "[1]"
|
||||
, Node (TFloat 3) "[2]"
|
||||
]
|
||||
, keyPath = ""
|
||||
}
|
||||
)
|
||||
, test "parses dictionaries" <|
|
||||
\_ ->
|
||||
JsonTree.parseValue
|
||||
(Encode.object
|
||||
[ ( "age", Encode.float 42 )
|
||||
, ( "name", Encode.string "Arnold" )
|
||||
]
|
||||
)
|
||||
|> Expect.equal
|
||||
(Ok
|
||||
{ value =
|
||||
TDict
|
||||
(Dict.fromList
|
||||
[ ( "age", { value = TFloat 42, keyPath = ".age" } )
|
||||
, ( "name", { value = TString "Arnold", keyPath = ".name" } )
|
||||
]
|
||||
)
|
||||
, keyPath = ""
|
||||
}
|
||||
)
|
||||
, test "parses lists of dictionaries" <|
|
||||
\_ ->
|
||||
JsonTree.parseValue
|
||||
(Encode.list
|
||||
(List.map Encode.object
|
||||
[ [ ( "age", Encode.float 42 )
|
||||
, ( "name", Encode.string "Arnold" )
|
||||
]
|
||||
, [ ( "age", Encode.float 99 )
|
||||
, ( "name", Encode.string "Lou" )
|
||||
]
|
||||
]
|
||||
)
|
||||
)
|
||||
|> Expect.equal
|
||||
(Ok
|
||||
{ value =
|
||||
TList
|
||||
[ { value =
|
||||
TDict
|
||||
(Dict.fromList
|
||||
[ ( "age", { value = TFloat 42, keyPath = "[0].age" } )
|
||||
, ( "name", { value = TString "Arnold", keyPath = "[0].name" } )
|
||||
]
|
||||
)
|
||||
, keyPath = "[0]"
|
||||
}
|
||||
, { value =
|
||||
TDict
|
||||
(Dict.fromList
|
||||
[ ( "age", { value = TFloat 99, keyPath = "[1].age" } )
|
||||
, ( "name", { value = TString "Lou", keyPath = "[1].name" } )
|
||||
]
|
||||
)
|
||||
, keyPath = "[1]"
|
||||
}
|
||||
]
|
||||
, keyPath = ""
|
||||
}
|
||||
)
|
||||
, test "parses dictionary of lists" <|
|
||||
\_ ->
|
||||
JsonTree.parseValue
|
||||
(Encode.object
|
||||
[ ( "names", Encode.list (List.map Encode.string [ "Arnold", "Lou" ]) ) ]
|
||||
)
|
||||
|> Expect.equal
|
||||
(Ok
|
||||
{ value =
|
||||
TDict
|
||||
(Dict.fromList
|
||||
[ ( "names"
|
||||
, { value =
|
||||
TList
|
||||
[ Node (TString "Arnold") ".names[0]"
|
||||
, Node (TString "Lou") ".names[1]"
|
||||
]
|
||||
, keyPath = ".names"
|
||||
}
|
||||
)
|
||||
]
|
||||
)
|
||||
, keyPath = ""
|
||||
}
|
||||
)
|
||||
]
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "Test Suites",
|
||||
"repository": "https://github.com/user/project.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"../src",
|
||||
"."
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"dependencies": {
|
||||
"eeue56/elm-html-test": "5.2.0 <= v < 6.0.0",
|
||||
"elm-community/elm-test": "4.0.0 <= v < 5.0.0",
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||
"jinjor/elm-inline-hover": "1.0.2 <= v < 2.0.0",
|
||||
"rtfeldman/elm-css": "13.1.1 <= v < 14.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
Загрузка…
Ссылка в новой задаче