PartialJSON.elm

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