module DittoMessageDecoder
    exposing
        ( AttributeId(AttributeId)
        , AttributePath(DeepAttribute, RootAttribute)
        , AttributeProperties(AttributeProperties)
        , DittoMessage(Created, Deleted, DittoError, Modified)
        , ErrorProperties(ErrorProperties)
        , FeatureId(FeatureId)
        , FeaturePath(DeepFeature, RootFeature)
        , FeatureProperties(FeatureProperties)
        , Headers(Headers)
        , PropertyPath(PropertyPath)
        , Revision(Revision)
        , Status(Status)
        , Thing(Thing)
        , ThingId(ThingId)
        , ThingNamespace(ThingNamespace)
        , What(Attribute, Feature)
        , WhatWasDeleted(AllAttributes, AllFeatures, SingleAttribute, SingleFeature)
        , dittoMessagesDecoder
        )

{-| .


# DittoMessageDecoder

A decoder for [Eclipse Ditto](https://eclipse.org/ditto/protocol-specification.html)
JSON messages into useful ELM [union types](https://guide.elm-lang.org/types/union_types.html).


## Decoder

@docs dittoMessagesDecoder


## Exposed Union Types

@docs DittoMessage, Thing, What, WhatWasDeleted

@docs ThingNamespace, ThingId

@docs PropertyPath

@docs AttributePath, AttributeId, AttributeProperties

@docs FeaturePath, FeatureId, FeatureProperties

@docs Headers, Revision

@docs ErrorProperties, Status

-}

import Dict
import Json.Decode exposing (Decoder, andThen, at, decodeString, decodeValue, fail, field, int, list, maybe, string, succeed, value)
import Json.Encode exposing (Value)


-- PUBLIC TYPES


{-| The root union type for the interpretation of the content of the JSON message.
-}
type DittoMessage
    = Created Thing What Headers Revision
    | Modified Thing What Headers Revision
    | Deleted Thing WhatWasDeleted Headers Revision
    | DittoError Headers ErrorProperties Status


{-| A single constructor union type to encapsulate that a Thing is always
represented by a namespace and an id.
-}
type Thing
    = Thing ThingNamespace ThingId


{-| A single constructor union type to encapsulate the namespace of a Thing.
-}
type ThingNamespace
    = ThingNamespace String


{-| A single constructor union type to encapsulate the id of a Thing.
-}
type ThingId
    = ThingId String


{-| When an attribute or a feature of a thing get created or modified, we have
access to the properties that were created/modified.
-}
type What
    = Attribute AttributePath AttributeProperties
    | Feature FeaturePath FeatureProperties


{-| When an attribute or a feature of a thing get deleted, we only have access
to the path that was deleted.
-}
type WhatWasDeleted
    = AllAttributes
    | SingleAttribute AttributePath
    | AllFeatures
    | SingleFeature FeaturePath


{-| As a simple example, `"path": "/attributes/topLevel"` would convert into
`RootAttribute (AttributeId "topLevel")`.

On the other hand, `"path": "/attributes/someAttribute/deep/deeper"` would
convert into `DeepAttribute (AttributeId "someAttribute") (PropertyPath "deep/deeper")`.

-}
type AttributePath
    = RootAttribute AttributeId
    | DeepAttribute AttributeId PropertyPath


{-| A single construtor union type, to encapsulate the id of an attribute of a thing.
-}
type AttributeId
    = AttributeId String


{-| A single constructor union type, to encapsulate the JSON Value payload of the attribute.
-}
type AttributeProperties
    = AttributeProperties Value


{-| A single constructor union type, used together with `DeepAttribute` and `DeepFeature`,
to convey what is the path beyond `/attributes/attributeId/` or `/features/featureId/properties/`.
-}
type PropertyPath
    = PropertyPath String


{-| A single constructor union type, to encapsulate the id of a feature of a thing.
-}
type FeatureId
    = FeatureId String


{-| A single constructor union type, to encapsulate the JSON Value payload of the feature.
-}
type FeatureProperties
    = FeatureProperties Value


{-| As a simple example, `"path": "/features/simpleFeature"` would convert into
`RootFeature (FeatureId "simpleFeature")`.

On the other hand, `"path": "/features/complexFeature/properties/complex-child"` would
convert into `DeepFeature (FeatureId "complexFeature") (PropertyPath "complex-child")`

-}
type FeaturePath
    = RootFeature FeatureId
    | DeepFeature FeatureId PropertyPath


{-| A single constructor union type to encapsulate the JSON Value payload of the
[headers](https://eclipse.org/ditto/protocol-specification.html#headers) of the message.
-}
type Headers
    = Headers Value


{-| A single constructor union type to encapsulate a
[Ditto Revision](https://eclipse.org/ditto/protocol-specification-things.html#api-version-2).
-}
type Revision
    = Revision Int


{-| A single construtor union type to encapsulate a
[Ditto Status](https://eclipse.org/ditto/protocol-specification.html#status).
-}
type Status
    = Status Int


{-| A single construtor union type to encapsulate the properties of a
[Ditto Error](https://eclipse.org/ditto/docson/index.html#../jsonschema/protocol-error_response.json$$expand).
-}
type ErrorProperties
    = ErrorProperties Value



-- PUBLIC FUNCTIONS


{-| The decoder that enables you to go from one single JSON payload into one or more
`DittoMessage`s. Special paths such as `/`, `/attributes`, `/features` can yield more
that one `DittoMessage`.
-}
dittoMessagesDecoder : Decoder (List DittoMessage)
dittoMessagesDecoder =
    decodeEventEnvelope
        |> andThen parseEnvelope
        |> andThen interpretEnvelope



-- PRIVATE TYPES


type PayloadValue
    = PayloadValue Value


type Topic
    = CreatedEvent Thing
    | ModifiedEvent Thing
    | DeletedEvent Thing
    | Error


type Path
    = Root
    | FeaturesRoot
    | TopLevelFeature FeatureId
    | TopLevelFeatureProperties FeatureId
    | FeatureProperty FeatureId PropertyPath
    | AttributesRoot
    | TopLevelAttribute AttributeId
    | AttributeProperty AttributeId PropertyPath


type ParsedEventEnvelope
    = EventEnvelope Topic Headers Path PayloadValue Revision
    | ErrorEnvelope Topic Headers Path PayloadValue Status


type alias RawEventEnvelope =
    { topic : String
    , headers : Value
    , path : String
    , value : Maybe Value
    , revision : Maybe Int
    , status : Maybe Int
    }



-- PRIVATE FUNCTIONS


decodeEventEnvelope : Decoder RawEventEnvelope
decodeEventEnvelope =
    Json.Decode.map6
        RawEventEnvelope
        (field "topic" string)
        (field "headers" value)
        (field "path" string)
        (maybe (field "value" value))
        (maybe (field "revision" int))
        (maybe (field "status" int))


parseEnvelope : RawEventEnvelope -> Decoder ParsedEventEnvelope
parseEnvelope rawEventEnvelope =
    let
        topicDecodeResult =
            rawEventEnvelope.topic |> topicDecoder

        pathDecodeResult =
            rawEventEnvelope.path |> pathDecoder

        headers =
            Headers rawEventEnvelope.headers

        payloadValue =
            PayloadValue (rawEventEnvelope.value |> Maybe.withDefault Json.Encode.null)
    in
    Json.Decode.map2
        (\topic path ->
            case topic of
                CreatedEvent thing ->
                    EventEnvelope topic headers path payloadValue (rawEventEnvelope.revision |> Maybe.withDefault 0 |> Revision)

                ModifiedEvent thing ->
                    EventEnvelope topic headers path payloadValue (rawEventEnvelope.revision |> Maybe.withDefault 0 |> Revision)

                DeletedEvent thing ->
                    EventEnvelope topic headers path payloadValue (rawEventEnvelope.revision |> Maybe.withDefault 0 |> Revision)

                Error ->
                    ErrorEnvelope topic headers path payloadValue (rawEventEnvelope.status |> Maybe.withDefault 0 |> Status)
        )
        topicDecodeResult
        pathDecodeResult


interpretEnvelope : ParsedEventEnvelope -> Decoder (List DittoMessage)
interpretEnvelope envelope =
    case envelope of
        -- CREATED ROOT
        EventEnvelope (CreatedEvent thing) headers Root (PayloadValue payloadValue) revision ->
            let
                attributesDecodeResult =
                    payloadValue
                        |> decodeValue (field "attributes" attributeModificationsDecoder)
                        |> Result.map
                            (List.map
                                (\attributeModification ->
                                    Created thing attributeModification headers revision
                                )
                            )

                featuresDecodeResult =
                    payloadValue
                        |> decodeValue (field "features" (featureModificationsDecoder (field "properties" value)))
                        |> Result.map
                            (List.map
                                (\featureModification ->
                                    Created thing featureModification headers revision
                                )
                            )
            in
            case ( attributesDecodeResult, featuresDecodeResult ) of
                ( Ok attributeModifications, Ok featureModifications ) ->
                    succeed <| attributeModifications ++ featureModifications

                ( Err reason, _ ) ->
                    fail reason

                ( _, Err reason ) ->
                    fail reason

        -- CREATED ATTRIBUTES
        EventEnvelope (CreatedEvent thing) headers (TopLevelAttribute attributeId) (PayloadValue payloadValue) revision ->
            succeed <| [ Created thing (Attribute (RootAttribute attributeId) (AttributeProperties payloadValue)) headers revision ]

        EventEnvelope (CreatedEvent thing) headers (AttributeProperty attributeId propertyPath) (PayloadValue payloadValue) revision ->
            succeed <| [ Created thing (Attribute (DeepAttribute attributeId propertyPath) (AttributeProperties payloadValue)) headers revision ]

        -- CREATED FEATURES
        EventEnvelope (CreatedEvent thing) headers FeaturesRoot (PayloadValue payloadValue) revision ->
            let
                featuresDecodeResult =
                    payloadValue
                        |> decodeValue (featureModificationsDecoder (field "properties" value))
                        |> Result.map
                            (List.map
                                (\featureModification ->
                                    Created thing featureModification headers revision
                                )
                            )
            in
            case featuresDecodeResult of
                Ok featureCreations ->
                    succeed <| featureCreations

                Err reason ->
                    fail reason

        EventEnvelope (CreatedEvent thing) headers (TopLevelFeature featureId) (PayloadValue payloadValue) revision ->
            let
                featuresDecodeResult =
                    payloadValue
                        |> decodeValue (field "properties" value)
            in
            case featuresDecodeResult of
                Ok featurePayload ->
                    succeed <| [ Created thing (Feature (RootFeature featureId) (FeatureProperties featurePayload)) headers revision ]

                Err reason ->
                    fail reason

        EventEnvelope (CreatedEvent thing) headers (TopLevelFeatureProperties featureId) (PayloadValue payloadValue) revision ->
            succeed <| [ Created thing (Feature (RootFeature featureId) (FeatureProperties payloadValue)) headers revision ]

        EventEnvelope (CreatedEvent thing) headers (FeatureProperty featureId propertyPath) (PayloadValue payloadValue) revision ->
            succeed <| [ Created thing (Feature (DeepFeature featureId propertyPath) (FeatureProperties payloadValue)) headers revision ]

        -- MODIFIED ROOT
        EventEnvelope (ModifiedEvent thing) headers Root (PayloadValue payloadValue) revision ->
            let
                attributesDecodeResult =
                    payloadValue
                        |> decodeValue (field "attributes" attributeModificationsDecoder)
                        |> Result.map
                            (List.map
                                (\attributeModification ->
                                    Modified thing attributeModification headers revision
                                )
                            )

                featuresDecodeResult =
                    payloadValue
                        |> decodeValue (field "features" (featureModificationsDecoder (field "properties" value)))
                        |> Result.map
                            (List.map
                                (\featureModification ->
                                    Modified thing featureModification headers revision
                                )
                            )
            in
            case ( attributesDecodeResult, featuresDecodeResult ) of
                ( Ok attributeModifications, Ok featureModifications ) ->
                    succeed <| attributeModifications ++ featureModifications

                ( Err reason, _ ) ->
                    fail reason

                ( _, Err reason ) ->
                    fail reason

        -- MODIFIED ATTRIBUTES
        EventEnvelope (ModifiedEvent thing) headers AttributesRoot (PayloadValue payloadValue) revision ->
            let
                attributesDecodeResult =
                    payloadValue
                        |> decodeValue attributeModificationsDecoder
                        |> Result.map
                            (List.map
                                (\attributeModification ->
                                    Modified thing attributeModification headers revision
                                )
                            )
            in
            case attributesDecodeResult of
                Ok attributeModifications ->
                    succeed <| attributeModifications

                Err reason ->
                    fail reason

        EventEnvelope (ModifiedEvent thing) headers (TopLevelAttribute attributeId) (PayloadValue payloadValue) revision ->
            succeed <| [ Modified thing (Attribute (RootAttribute attributeId) (AttributeProperties payloadValue)) headers revision ]

        EventEnvelope (ModifiedEvent thing) headers (AttributeProperty attributeId propertyPath) (PayloadValue payloadValue) revision ->
            succeed <| [ Modified thing (Attribute (DeepAttribute attributeId propertyPath) (AttributeProperties payloadValue)) headers revision ]

        -- MODIFIED FEATURES
        EventEnvelope (ModifiedEvent thing) headers FeaturesRoot (PayloadValue payloadValue) revision ->
            let
                featuresDecodeResult =
                    payloadValue
                        |> decodeValue (featureModificationsDecoder (field "properties" value))
                        |> Result.map
                            (List.map
                                (\featureModification ->
                                    Modified thing featureModification headers revision
                                )
                            )
            in
            case featuresDecodeResult of
                Ok featureModifications ->
                    succeed <| featureModifications

                Err reason ->
                    fail reason

        EventEnvelope (ModifiedEvent thing) headers (TopLevelFeature featureId) (PayloadValue payloadValue) revision ->
            let
                propertiesFieldDecodeResult =
                    payloadValue
                        |> decodeValue (field "properties" value)
            in
            case propertiesFieldDecodeResult of
                Ok featurePayload ->
                    succeed <| [ Modified thing (Feature (RootFeature featureId) (FeatureProperties featurePayload)) headers revision ]

                Err reason ->
                    fail reason

        EventEnvelope (ModifiedEvent thing) headers (TopLevelFeatureProperties featureId) (PayloadValue payloadValue) revision ->
            let
                propertiesFieldDecodeResult =
                    payloadValue
                        |> decodeValue value
            in
            case propertiesFieldDecodeResult of
                Ok featurePayload ->
                    succeed <| [ Modified thing (Feature (RootFeature featureId) (FeatureProperties featurePayload)) headers revision ]

                Err reason ->
                    fail reason

        EventEnvelope (ModifiedEvent thing) headers (FeatureProperty featureId propertyPath) (PayloadValue payloadValue) revision ->
            let
                propertiesFieldDecodeResult =
                    payloadValue
                        |> decodeValue value
            in
            case propertiesFieldDecodeResult of
                Ok featurePayload ->
                    succeed <| [ Modified thing (Feature (DeepFeature featureId propertyPath) (FeatureProperties featurePayload)) headers revision ]

                Err reason ->
                    fail reason

        -- DELETED ATTRIBUTES
        EventEnvelope (DeletedEvent thing) headers AttributesRoot _ revision ->
            succeed <| [ Deleted thing AllAttributes headers revision ]

        EventEnvelope (DeletedEvent thing) headers (TopLevelAttribute attributeId) _ revision ->
            succeed <| [ Deleted thing (SingleAttribute (RootAttribute attributeId)) headers revision ]

        EventEnvelope (DeletedEvent thing) headers (AttributeProperty attributeId propertyPath) _ revision ->
            succeed <| [ Deleted thing (SingleAttribute (DeepAttribute attributeId propertyPath)) headers revision ]

        -- DELETED FEATURES
        EventEnvelope (DeletedEvent thing) headers FeaturesRoot _ revision ->
            succeed <| [ Deleted thing AllFeatures headers revision ]

        EventEnvelope (DeletedEvent thing) headers (TopLevelFeature featureId) _ revision ->
            succeed <| [ Deleted thing (SingleFeature (RootFeature featureId)) headers revision ]

        EventEnvelope (DeletedEvent thing) headers (TopLevelFeatureProperties featureId) _ revision ->
            succeed <| [ Deleted thing (SingleFeature (RootFeature featureId)) headers revision ]

        EventEnvelope (DeletedEvent thing) headers (FeatureProperty featureId propertyPath) _ revision ->
            succeed <| [ Deleted thing (SingleFeature (DeepFeature featureId propertyPath)) headers revision ]

        -- ERRORS
        ErrorEnvelope Error headers Root (PayloadValue payloadValue) status ->
            succeed <| [ DittoError headers (ErrorProperties payloadValue) status ]

        other ->
            fail <| ("Unknown scenario: " ++ toString other)


topicDecoder : String -> Decoder Topic
topicDecoder topicStr =
    case topicStr |> String.split "/" of
        [ namespace, thingId, "things", channel, "events", "created" ] ->
            succeed <| CreatedEvent (Thing (ThingNamespace namespace) (ThingId thingId))

        [ namespace, thingId, "things", channel, "events", "modified" ] ->
            succeed <| ModifiedEvent (Thing (ThingNamespace namespace) (ThingId thingId))

        [ namespace, thingId, "things", channel, "events", "deleted" ] ->
            succeed <| DeletedEvent (Thing (ThingNamespace namespace) (ThingId thingId))

        [ "unknown", "unknown", "things", channel, "errors" ] ->
            succeed <| Error

        other ->
            fail <| ("Unable to parse topic [" ++ topicStr ++ "]")


pathDecoder : String -> Decoder Path
pathDecoder pathStr =
    case pathStr |> String.dropLeft 1 |> String.split "/" of
        [ "" ] ->
            succeed <| Root

        [ "attributes" ] ->
            succeed <| AttributesRoot

        [ "attributes", attributeId ] ->
            succeed <| TopLevelAttribute (AttributeId attributeId)

        "attributes" :: attributeId :: rest ->
            succeed <| AttributeProperty (AttributeId attributeId) (PropertyPath (rest |> String.join "/"))

        [ "features" ] ->
            succeed <| FeaturesRoot

        [ "features", featureId ] ->
            succeed <| TopLevelFeature (FeatureId featureId)

        [ "features", featureId, "properties" ] ->
            succeed <| TopLevelFeatureProperties (FeatureId featureId)

        "features" :: featureId :: "properties" :: rest ->
            succeed <| FeatureProperty (FeatureId featureId) (PropertyPath (rest |> String.join "/"))

        other ->
            fail ("Unable to parse path [" ++ pathStr ++ "]")


attributeModificationsDecoder : Decoder (List What)
attributeModificationsDecoder =
    Json.Decode.dict value
        |> andThen (Dict.toList >> List.map toAttributeModified >> succeed)


toAttributeModified : ( String, Value ) -> What
toAttributeModified ( attributeId, attributeProperties ) =
    Attribute (RootAttribute (AttributeId attributeId)) (AttributeProperties attributeProperties)


featureModificationsDecoder : Decoder Value -> Decoder (List What)
featureModificationsDecoder payloadValueDecoder =
    Json.Decode.dict value
        |> andThen (Dict.toList >> succeed)
        |> andThen (featuresDecoder payloadValueDecoder >> succeed)


featuresDecoder : Decoder Value -> List ( String, Value ) -> List What
featuresDecoder payloadValueDecoder =
    List.filterMap (toFeatureModified payloadValueDecoder)


toFeatureModified : Decoder Value -> ( String, Value ) -> Maybe What
toFeatureModified payloadValueDecoder ( featureId, featurePayload ) =
    featurePayload
        |> decodeValue (featurePropertiesDecoder payloadValueDecoder)
        |> Result.map (\featureProperties -> Feature (RootFeature (FeatureId featureId)) featureProperties)
        |> Result.toMaybe


featurePropertiesDecoder : Decoder Value -> Decoder FeatureProperties
featurePropertiesDecoder =
    andThen (FeatureProperties >> succeed)