Created
August 19, 2019 22:54
-
-
Save miniBill/ddabb65e9f51763a6d2ef73afeb7431b to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main exposing (main) | |
import Browser | |
import Html exposing (Html) | |
import Html.Attributes as Html | |
import Html.Events as Html | |
import List.Extra as List | |
type alias Model = | |
String | |
type Msg | |
= Input String | |
main : Program () Model Msg | |
main = | |
Browser.sandbox | |
{ init = init | |
, view = view | |
, update = update | |
} | |
init : Model | |
init = | |
"Log: {\"a\":[\"string\",{\"key\"\t:0,\"key\"\t:\"0\",\"key\"\t:\"string\",\"key\"\t:true,\"key\"\t:false,\"key\":null}\n,\"Gufo blu\",[]],\"b\":{\"partial\":\"test\"}}\nMore log!\nSome more lines" | |
view : Model -> Html Msg | |
view model = | |
let | |
lines = | |
String.split "\n" model | |
rows = | |
lines | |
|> List.length | |
|> (\r -> r + 2) | |
cols = | |
lines | |
|> List.map String.length | |
|> List.maximum | |
|> Maybe.withDefault 0 | |
|> (\c -> c + 2) | |
|> clamp 10 100 | |
in | |
Html.div [] | |
[ Html.textarea | |
[ Html.onInput Input | |
, Html.value model | |
, Html.rows rows | |
, Html.cols cols | |
] | |
[] | |
, Html.br [] [] | |
, pretty model | |
] | |
type Tree | |
= String String | |
| Array (List Tree) | |
| Int Int | |
| Object (List ( String, Tree )) | |
| Bool Bool | |
| Null | |
type alias PartialParser a = | |
String -> Maybe ( a, String ) | |
pretty : String -> Html msg | |
pretty = | |
parse >> showParsed | |
parse : String -> List Piece | |
parse = | |
parseTopLevel |> orText | |
parseTopLevel : PartialParser Tree | |
parseTopLevel = | |
parseObject | |
|> or parseArray | |
|> log "parseTopLevel" | |
parseValue : PartialParser Tree | |
parseValue = | |
parseObject | |
|> or parseArray | |
|> or parseInt | |
|> or parseString | |
|> or parseBool | |
|> or parseNull | |
|> log "parseValue" | |
or : PartialParser a -> PartialParser a -> PartialParser a | |
or second first input = | |
case first input of | |
Just v -> | |
Just v | |
Nothing -> | |
second input | |
orText : PartialParser Tree -> String -> List Piece | |
orText partial input = | |
case partial input of | |
Just ( tree, rest ) -> | |
Tree tree :: parse rest | |
Nothing -> | |
case String.uncons input of | |
Just ( first, rest ) -> | |
Text (String.fromChar first) :: parse rest | |
Nothing -> | |
[] | |
seq : PartialParser a -> PartialParser (a -> b) -> PartialParser b | |
seq px pf input = | |
case pf input of | |
Just ( f, rest ) -> | |
map f px <| String.trimLeft rest | |
Nothing -> | |
Nothing | |
seq_ : PartialParser a -> PartialParser (a -> b) -> PartialParser b | |
seq_ px pf input = | |
case pf input of | |
Just ( f, rest ) -> | |
map f px rest | |
Nothing -> | |
Nothing | |
map : (a -> r) -> PartialParser a -> PartialParser r | |
map f p input = | |
p input |> Maybe.map (Tuple.mapFirst f) | |
map2 : (a -> b -> r) -> PartialParser a -> PartialParser b -> PartialParser r | |
map2 f pa pb = | |
map f pa |> seq pb | |
map2_ : (a -> b -> r) -> PartialParser a -> PartialParser b -> PartialParser r | |
map2_ f pa pb = | |
map f pa |> seq_ pb | |
map3 f pa pb pc = | |
map f pa |> seq pb |> seq pc | |
map4 f pa pb pc pd = | |
map f pa |> seq pb |> seq pc |> seq pd | |
map5 f pa pb pc pd pe = | |
map f pa |> seq pb |> seq pc |> seq pd |> seq pe | |
andThen f p input = | |
p input |> Maybe.andThen (\( x, r ) -> Maybe.map (\y -> ( y, r )) (f x)) | |
loop : String -> PartialParser a -> String -> String -> PartialParser (List a) | |
loop left element separator right = | |
let | |
go : PartialParser (List a) | |
go s = | |
parseLiteral right | |
|> map (\_ -> []) | |
|> or | |
(map2 (::) | |
element | |
(parseLiteral right | |
|> map (\_ -> []) | |
|> or | |
(\i -> | |
map2 (\_ pairs -> pairs) | |
(parseLiteral separator) | |
go | |
i | |
) | |
) | |
) | |
|> (\f -> f s) | |
in | |
map2 (\_ pairs -> pairs) (parseLiteral left) go | |
parseObject : PartialParser Tree | |
parseObject = | |
let | |
parsePair input = | |
map3 (\key _ value -> ( key, value )) | |
parseKey | |
(parseLiteral ":") | |
parseValue | |
input | |
in | |
loop "{" parsePair "," "}" | |
|> map Object | |
|> log "parseObject" | |
parseLiteral : String -> PartialParser () | |
parseLiteral lit = | |
log ("parseLiteral " ++ Debug.toString lit) <| | |
\input -> | |
if String.startsWith lit input then | |
Just ( (), String.dropLeft (String.length lit) input ) | |
else | |
Nothing | |
parseArray : PartialParser Tree | |
parseArray = | |
loop "[" (\input -> parseValue input) "," "]" | |
|> map Array | |
|> log "parseArray" | |
log : String -> PartialParser a -> PartialParser a | |
log name raw input = | |
let | |
cut = | |
input | |
|> String.replace "\t" "\\t" | |
|> String.replace "\n" "\\n" | |
|> String.slice 1 -1 | |
|> String.left 10 | |
|> String.padRight 10 ' ' | |
in | |
if False then | |
Debug.log (String.padRight 20 ' ' name ++ " " ++ cut) <| raw input | |
else | |
raw input | |
parseInt : PartialParser Tree | |
parseInt input = | |
input | |
|> String.toList | |
|> List.span Char.isDigit | |
|> (\( ds, rest ) -> | |
if List.isEmpty ds then | |
Nothing | |
else | |
String.toInt (String.fromList ds) | |
|> Maybe.map (\i -> ( Int i, String.fromList rest )) | |
) | |
parseString : PartialParser Tree | |
parseString = | |
map String parseKey | |
parseKey : PartialParser String | |
parseKey = | |
loop "\"" (\input -> parseStringChar input) "" "\"" | |
|> map String.fromList | |
|> log "parseKey" | |
parseBool : PartialParser Tree | |
parseBool = | |
(parseLiteral "true" |> map (\_ -> Bool True)) | |
|> or (parseLiteral "false" |> map (\_ -> Bool False)) | |
parseNull : PartialParser Tree | |
parseNull = | |
parseLiteral "null" |> map (always Null) | |
parseStringChar : PartialParser Char | |
parseStringChar = | |
let | |
escapedPiece key value = | |
parseLiteral key |> map (always value) | |
hexDigit = | |
parseChar | |
|> andThen | |
(\c -> | |
let | |
val = | |
Char.toCode c | |
in | |
if val >= 48 && val <= 57 then | |
Just <| val - 48 | |
else if val >= 65 && val <= 70 then | |
Just <| val - 65 + 16 | |
else if val >= 97 && val <= 102 then | |
Just <| val - 97 + 16 | |
else | |
Nothing | |
) | |
hex = | |
map5 (\_ a b c d -> Char.fromCode <| a * 256 * 256 * 256 + b * 256 * 256 + c * 256 + d) | |
(parseLiteral "u") | |
hexDigit | |
hexDigit | |
hexDigit | |
hexDigit | |
escaped = | |
map2_ (\_ c -> c) | |
(parseLiteral "\\") | |
(escapedPiece "\"" (Char.fromCode 22) | |
|> or (escapedPiece "\\" '\\') | |
|> or (escapedPiece "/" '/') | |
|> or (escapedPiece "b" '\u{0008}') | |
|> or (escapedPiece "f" '\u{000C}') | |
|> or (escapedPiece "n" '\n') | |
|> or (escapedPiece "r" '\u{000D}') | |
|> or (escapedPiece "t" '\t') | |
|> or hex | |
) | |
literal = | |
parseChar | |
|> andThen | |
(\c -> | |
if Char.toCode c == 22 || c == '\\' then | |
Nothing | |
else | |
Just c | |
) | |
in | |
escaped |> or literal | |
parseChar : PartialParser Char | |
parseChar = | |
String.uncons | |
themeBlack : String | |
themeBlack = | |
"#282C34" | |
themeRed : String | |
themeRed = | |
"#E06C75" | |
themeGreen : String | |
themeGreen = | |
"#98C379" | |
themeYellow : String | |
themeYellow = | |
"#E5C07B" | |
themeBlue : String | |
themeBlue = | |
"#61AFEF" | |
themeViolet : String | |
themeViolet = | |
"#C678DD" | |
themeTeal : String | |
themeTeal = | |
"#56B6C2" | |
themeGray : String | |
themeGray = | |
"#ABB2BF" | |
braceColor : String | |
braceColor = | |
themeTeal | |
backgroundColor : String | |
backgroundColor = | |
themeBlack | |
foregroundColor : String | |
foregroundColor = | |
themeGray | |
commaColor : String | |
commaColor = | |
themeGray | |
keyColor : String | |
keyColor = | |
themeTeal | |
boolColor : String | |
boolColor = | |
themeViolet | |
nullColor : String | |
nullColor = | |
themeRed | |
stringColor : String | |
stringColor = | |
themeBlue | |
intColor : String | |
intColor = | |
themeYellow | |
colonColor : String | |
colonColor = | |
themeGray | |
showParsed parsed = | |
let | |
simplify xs = | |
case xs of | |
[] -> | |
[] | |
(Text a) :: (Text b) :: c -> | |
simplify (Text (a ++ b) :: c) | |
y :: ys -> | |
y :: simplify ys | |
in | |
parsed | |
|> simplify | |
|> List.concatMap showPiece | |
|> Html.div | |
[ Html.style "background-color" backgroundColor | |
] | |
type Piece | |
= Text String | |
| Tree Tree | |
showPiece piece = | |
let | |
box e = | |
Html.div | |
[ Html.style "display" "table-cell" | |
, Html.style "vertical-align" "middle" | |
, Html.style "color" foregroundColor | |
] | |
[ e | |
] | |
in | |
case piece of | |
Text t -> | |
t | |
|> String.split "\n" | |
|> List.map (box << Html.text) | |
|> List.intersperse (Html.br [] []) | |
Tree t -> | |
[ box <| showTree t ] | |
showTree tree = | |
case tree of | |
String s -> | |
showString s | |
Array es -> | |
showArray es | |
Object es -> | |
showObject es | |
Bool b -> | |
Html.span [ Html.style "color" boolColor ] | |
[ Html.text <| | |
if b then | |
"true" | |
else | |
"false" | |
] | |
Null -> | |
Html.span [ Html.style "color" nullColor ] | |
[ Html.text "null" ] | |
Int i -> | |
Html.span [ Html.style "color" intColor ] [ Html.text <| String.fromInt i ] | |
showString : String -> Html msg | |
showString s = | |
Html.span [ Html.style "color" stringColor ] [ Html.text <| "\"" ++ s ++ "\"" ] | |
showObject : List ( String, Tree ) -> Html msg | |
showObject es = | |
let | |
hook attrs = | |
Html.div | |
([ Html.style "color" backgroundColor | |
, Html.style "height" "25%" | |
, Html.style "display" "inline-block" | |
] | |
++ attrs | |
) | |
[ Html.text "." ] | |
tr = | |
hook | |
[ Html.style "border-left" <| "1px solid " ++ braceColor | |
, Html.style "border-top-left-radius" "20px" | |
, Html.style "margin-left" "4px" | |
] | |
bl = | |
hook | |
[ Html.style "border-right" <| "1px solid " ++ braceColor | |
, Html.style "border-bottom-right-radius" "20px" | |
, Html.style "margin-right" "4px" | |
] | |
tl = | |
hook | |
[ Html.style "border-right" <| "1px solid " ++ braceColor | |
, Html.style "border-top-right-radius" "20px" | |
, Html.style "margin-right" "4px" | |
] | |
br = | |
hook | |
[ Html.style "border-left" <| "1px solid " ++ braceColor | |
, Html.style "border-bottom-left-radius" "20px" | |
, Html.style "margin-left" "4px" | |
] | |
left = | |
[ Html.td | |
[ Html.rowspan (List.length es) | |
, Html.style "height" "inherit" | |
] | |
[ tr | |
, Html.br [] [] | |
, bl | |
, Html.br [] [] | |
, tl | |
, Html.br [] [] | |
, br | |
] | |
] | |
right = | |
[ Html.td | |
[ Html.rowspan (List.length es) | |
, Html.style "height" "inherit" | |
] | |
[ tl | |
, Html.br [] [] | |
, br | |
, Html.br [] [] | |
, tr | |
, Html.br [] [] | |
, bl | |
] | |
] | |
rows = | |
List.indexedMap | |
(\i ( k, v ) -> | |
let | |
mid = | |
[ Html.td | |
[ Html.style "color" keyColor ] | |
[ Html.text <| "\"" ++ k ++ "\"" ] | |
, Html.td | |
[ Html.style "color" colonColor ] | |
[ Html.text ":" ] | |
, Html.td [] [ showTree v ] | |
] | |
in | |
if i == 0 then | |
Html.tr [ Html.style "height" "1px" ] <| left ++ mid ++ right | |
else | |
Html.tr [] mid | |
) | |
es | |
in | |
Html.div | |
[ Html.style "display" "inline-block" ] | |
[ Html.table [] rows ] | |
showArray : List Tree -> Html msg | |
showArray es = | |
let | |
left = | |
Html.td | |
[ Html.style "border-top" <| "1px solid " ++ braceColor | |
, Html.style "border-bottom" <| "1px solid " ++ braceColor | |
, Html.style "border-left" <| "1px solid " ++ braceColor | |
, Html.style "color" backgroundColor | |
] | |
[ Html.text "." ] | |
mid = | |
es | |
|> List.map showTree | |
|> List.intersperse (Html.text ",") | |
|> List.map (\e -> Html.td [ Html.style "color" commaColor ] [ e ]) | |
right = | |
Html.td | |
[ Html.style "border-top" <| "1px solid " ++ braceColor | |
, Html.style "border-bottom" <| "1px solid " ++ braceColor | |
, Html.style "border-right" <| "1px solid " ++ braceColor | |
, Html.style "color" backgroundColor | |
] | |
[ Html.text "." ] | |
row = | |
Html.tr [] <| [ left ] ++ mid ++ [ right ] | |
in | |
Html.div | |
[ Html.style "display" "inline-block" ] | |
[ Html.table [] [ row ] ] | |
update : Msg -> Model -> Model | |
update msg model = | |
case msg of | |
Input str -> | |
str |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment