diff --git a/elm.json b/elm.json index f7e862c..66e87bf 100644 --- a/elm.json +++ b/elm.json @@ -3,7 +3,7 @@ "name": "noordstar/elm-matrix-sdk-beta", "summary": "Matrix SDK for instant communication. Unstable beta version for testing only.", "license": "EUPL-1.1", - "version": "2.1.1", + "version": "2.1.2", "exposed-modules": [ "Matrix", "Matrix.Event", diff --git a/src/Internal/Config/Default.elm b/src/Internal/Config/Default.elm index ffbd273..c4cd6ad 100644 --- a/src/Internal/Config/Default.elm +++ b/src/Internal/Config/Default.elm @@ -23,7 +23,7 @@ will assume until overriden by the user. -} currentVersion : String currentVersion = - "beta 2.1.1" + "beta 2.1.2" {-| The default device name that is being communicated with the Matrix API. diff --git a/src/Internal/Config/Leaks.elm b/src/Internal/Config/Leaks.elm index d9f2d07..6562b0a 100644 --- a/src/Internal/Config/Leaks.elm +++ b/src/Internal/Config/Leaks.elm @@ -1,4 +1,7 @@ -module Internal.Config.Leaks exposing (accessToken, baseUrl, transaction, versions) +module Internal.Config.Leaks exposing + ( accessToken, baseUrl, transaction, versions + , allLeaks + ) {-| @@ -29,8 +32,14 @@ know 100% sure that the value isn't `Nothing`. @docs accessToken, baseUrl, transaction, versions +For safety purposes, all leaking values are stored in the following value: + +@docs allLeaks + -} +import Set exposing (Set) + {-| Placeholder access token. -} @@ -39,6 +48,20 @@ accessToken = "elm-sdk-placeholder-access-token-leaks" +{-| Complete set of all leaking values. Commonly using for testing purposes. +-} +allLeaks : Set String +allLeaks = + Set.union + (Set.fromList versions) + (Set.fromList + [ accessToken + , baseUrl + , transaction + ] + ) + + {-| Placeholder base URL. -} baseUrl : String diff --git a/src/Internal/Config/Log.elm b/src/Internal/Config/Log.elm new file mode 100644 index 0000000..90a7abd --- /dev/null +++ b/src/Internal/Config/Log.elm @@ -0,0 +1,105 @@ +module Internal.Config.Log exposing (Log, log) + +{-| + + +# Logs + +The logs module exposes various log types that can be used to indicate logs. +This helps users filter for the logs that they care about. + +@docs Log, log + +The logs are encoded as strings as to allow the addition of new log types +without triggering a major update. + +-} + +-- @docs caughtError, debug, error, info, securityWarn, warn + + +{-| Common pattern for a log message. The log message consists of a log channel +like `debug`, `warn`, `error`, etc. and the content of the message. + +These logs are completely optional: they can be ignored, they can be sent to the +console, or a dialog may be created that presents the log messages. + +-} +type alias Log = + { channel : String, content : String } + + +{-| Create a log message of various log types. +-} +log : + { caughtError : String -> Log + , debug : String -> Log + , error : String -> Log + , info : String -> Log + , securityWarn : String -> Log + , warn : String -> Log + } +log = + { caughtError = Log caughtError + , debug = Log debug + , error = Log error + , info = Log info + , securityWarn = Log securityWarn + , warn = Log warn + } + + +{-| A caught error is an error that has been caught elsewhere in the code, hence +functioning as a secondary debug channel. +-} +caughtError : String +caughtError = + "caught-error" + + +{-| Debug logs are logs that can be used to debug API interactions. +-} +debug : String +debug = + "debug" + + +{-| Error strings indicate that something unexpected has happened. As a result, +something has stopped working. +-} +error : String +error = + "error" + + +{-| Info contains relevant info for the user +-} +info : String +info = + "info" + + +{-| Security warnings are warnings that contain red flags. + +Of course, the Elm SDK is not aware of any security vulnerabilities that it +contains, but it can raise a user's attention to suspicious situations. + +For example, if the homeserver returns room ids that do not look like usernames +at all, the homeserver can raise a security warning, which indicates that: + +1. The homeserver might be bugged +2. The Elm SDK might be severaly outdated +3. The homeserver might be compromised and/or trying to attack the Elm SDK + +-} +securityWarn : String +securityWarn = + "security-warn" + + +{-| Warning logs are logs that are unusual, but that can be dealt with. Warnings +are debug logs that are out of the ordinary. +-} +warn : String +warn = + "warn" diff --git a/src/Internal/Config/Phantom.elm b/src/Internal/Config/Phantom.elm new file mode 100644 index 0000000..c378581 --- /dev/null +++ b/src/Internal/Config/Phantom.elm @@ -0,0 +1,51 @@ +module Internal.Config.Phantom exposing (PString(..), PInt(..), PBool(..), PList(..)) + +{-| + + +# Phantom types + +This module contains a lot of phantom types that do not necessarily do anything, +but they force the compiler to create an error whenever something illegal is +done. + +Compiler errors may seem annoying, they can help you write good code. In a +functional programming language like Elm, the trick is to design your code in +such a way that if it compiles, it works. Phantom types can help you do so. + +The phantom types in this module help you in the following way: + +1. They can help force an compile to fault when you forget to run a function. + +2. They can help track values for security. + + +## Standard data types + +@docs PString, PInt, PBool, PList + +-} + + +{-| Opaque type that encapsulates a bool. +-} +type PBool ph + = PBool Bool + + +{-| Opaque type that encapsulates an int. +-} +type PInt ph + = PInt Int + + +{-| Opaque type that encapsulates a list. +-} +type PList ph a + = PList (List a) + + +{-| Opaque type that encapsulates a string. +-} +type PString ph + = PString String diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index 0a7bd62..df063b5 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -1,7 +1,9 @@ module Internal.Config.Text exposing - ( versionsFoundLocally, versionsReceived, versionsFailedToDecode + ( docs, failures, fields , accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid + , versionsFoundLocally, versionsReceived, versionsFailedToDecode , unsupportedVersionForEndpoint + , decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound ) {-| Throughout the Elm SDK, there are lots of pieces of text being used for @@ -23,12 +25,9 @@ This is a risky feature, keep in mind that even a patch update might break this! You should only do this if you know what you're doing. -## API Versions +## Type documentation -Messages sent as API logs while the Elm SDK is figuring out how modern the -homeserver is and how it can best communicate. - -@docs versionsFoundLocally, versionsReceived, versionsFailedToDecode +@docs docs, failures, fields ## API Authentication @@ -41,15 +40,38 @@ interaction. offers room for translation, re-wording and refactors. +## API Versions + +Messages sent as API logs while the Elm SDK is figuring out how modern the +homeserver is and how it can best communicate. + +@docs versionsFoundLocally, versionsReceived, versionsFailedToDecode + + ## API miscellaneous messages Messages sent as API logs during communication with the API. @docs unsupportedVersionForEndpoint + +## JSON decoder + +Messages sent as API logs when a JSON value is being decoded. + +@docs decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound + -} +type alias Desc = + List String + + +type alias TypeDocs = + { name : String, description : Desc } + + {-| Logs when the Matrix API returns that an access token is no longer valid. -} accessTokenExpired : String @@ -73,6 +95,258 @@ accessTokenInvalid = "Matrix API rejected access token as invalid" +{-| Logs when the JSON decoder detects that an imported dictionary contained +duplicate keys. +-} +decodedDictSize : Int -> Int -> String +decodedDictSize from to = + String.concat + [ "JSON dict contained duplicate keys (JSON had " + , String.fromInt from + , " keys, Elm dict has " + , String.fromInt to + , " keys)" + ] + + +{-| Documentation used for all functions and data types in JSON coders +-} +docs : + { context : TypeDocs + , envelope : TypeDocs + , event : TypeDocs + , hashdict : TypeDocs + , mashdict : TypeDocs + , settings : TypeDocs + , stateManager : TypeDocs + , unsigned : TypeDocs + } +docs = + { context = + { name = "Context" + , description = + [ "The Context is the set of variables that the user (mostly) cannot control." + , "The Context contains tokens, values and other bits that the Vault receives from the Matrix API." + ] + } + , envelope = + { name = "Envelope" + , description = + [ "The Envelope module wraps existing data types with lots of values and settings that can be adjusted manually." + ] + } + , event = + { name = "Event" + , description = + [ "The Event type represents a single value that contains all the information for a single event in the room." + ] + } + , hashdict = + { name = "Hashdict" + , description = + [ "This allows you to store values based on an externally defined identifier." + , "For example, the hashdict can store events and use their event id as their key." + ] + } + , mashdict = + { name = "Mashdict" + , description = + [ "The mashdict exclusively stores values for which the hashing algorithm returns a value, and it ignores the outcome for all other scenarios." + ] + } + , settings = + { name = "Settings" + , description = + [ "The settings type is a data type to configure settings in the enveloped data type." + ] + } + , stateManager = + { name = "StateManager" + , description = + [ "The StateManager tracks the room state based on events, their event types and the optional state keys they provide." + , "Instead of making the user loop through the room's timeline of events, the StateManager offers the user a dictionary-like experience to navigate through the Matrix room state." + ] + } + , unsigned = + { name = "Unsigned Data" + , description = + [ "Unsigned data is optional data that might come along with the event." + , "This information is often supportive but not necessary to the context." + ] + } + } + + +{-| Description of all edge cases where a JSON decoder can fail. +-} +failures : { hashdict : Desc, mashdict : Desc } +failures = + { hashdict = + [ "Not all values map to thir respected hash with the given hash function." + ] + , mashdict = + [ "Not all values map to thir respected hash with the given hash function." + ] + } + + +{-| Objects contain multiple fields. These fields are here described, explaining +what they do and what they are for. +-} +fields : + { context : + { accessToken : Desc + , baseUrl : Desc + , password : Desc + , refreshToken : Desc + , username : Desc + , transaction : Desc + , versions : Desc + } + , envelope : + { content : Desc + , context : Desc + , settings : Desc + } + , event : + { content : Desc + , eventId : Desc + , originServerTs : Desc + , roomId : Desc + , sender : Desc + , stateKey : Desc + , eventType : Desc + , unsigned : Desc + } + , settings : + { currentVersion : Desc + , deviceName : Desc + , syncTime : Desc + } + , unsigned : + { age : Desc + , prevContent : Desc + , redactedBecause : Desc + , transactionId : Desc + } + } +fields = + { context = + { accessToken = + [ "The access token used for authentication with the Matrix server." + ] + , baseUrl = + [ "The base URL of the Matrix server." + ] + , password = + [ "The user's password for authentication purposes." + ] + , refreshToken = + [ "The token used to obtain a new access token upon expiration of the current access token." + ] + , username = + [ "The username of the Matrix account." + ] + , transaction = + [ "A unique identifier for a transaction initiated by the user." + ] + , versions = + [ "The versions of the Matrix protocol that are supported by the server." + ] + } + , envelope = + { content = + [ "The actual data or payload that is wrapped within the envelope." + ] + , context = + [ "The context information associated with the envelope, such as environment or session details." + , "In general, this data cannot be directly configured by the user." + ] + , settings = + [ "The configurable settings that affect how the enveloped data is handled or processed." + ] + } + , event = + { content = + [ "The body of this event, as created by the client which sent it." + ] + , eventId = + [ "The globally unique identifier for this event." + ] + , originServerTs = + [ "Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent." + ] + , roomId = + [ "The ID of the room associated with this event." + ] + , sender = + [ "Contains the fully-qualified ID of the user who sent this event." + ] + , stateKey = + [ "Present if, and only if, this event is a state event. The key making this piece of state unique in the room. Note that it is often an empty string." + , "State keys starting with an @ are reserved for referencing user IDs, such as room members. With the exception of a few events, state events set with a given user’s ID as the state key MUST only be set by that user." + ] + , eventType = + [ "The type of the event." + ] + , unsigned = + [ "Contains optional extra information about the event." + ] + } + , settings = + { currentVersion = + [ "Indicates the current version of the Elm SDK." + ] + , deviceName = + [ "Indicates the device name that is communicated to the Matrix API." + ] + , syncTime = + [ "Indicates the frequency in miliseconds with which the Elm SDK should long-poll the /sync endpoint." + ] + } + , unsigned = + { age = + [ "The time in milliseconds that has elapsed since the event was sent. This field is generated by the local homeserver, and may be incorrect if the local time on at least one of the two servers is out of sync, which can cause the age to either be negative or greater than it actually is." + ] + , prevContent = + [ "The previous content for this event. This field is generated by the local homeserver, and is only returned if the event is a state event, and the client has permission to see the previous content." + ] + , redactedBecause = + [ "The event that redacted this event, if any." + ] + , transactionId = + [ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it." + ] + } + } + + +{-| This message will be shown when a [Hashdict](Internal-Tools-Hashdict) +encounters a hash-value pair where the value does not hash to the provided hash. +-} +invalidHashInHashdict : String +invalidHashInHashdict = + "Invalid hash function: not all elements hash to their JSON-stored hashes" + + +{-| This message will be shown when a [Mashdict](Internal-Tools-Mashdict) +encounters a hash-value pair where the value does not hash to the provided hash. +-} +invalidHashInMashdict : String +invalidHashInMashdict = + "Invalid hash function: not all elements hash to their JSON-stored hashes" + + +{-| The Elm SDK occassionally uses [leaking values](Internal-Config-Leaks), +which might indicate exceptional behaviour. As such, this log is sent when one +of those leaking values is found: to alert the user that something fishy might +be going on. +-} +leakingValueFound : String -> String +leakingValueFound leaking_value = + "Found leaking value : " ++ leaking_value + + {-| The Matrix homeserver can specify how it wishes to communicate, and the Elm SDK aims to communicate accordingly. This may fail in some scenarios, however, in which case it will throw this error. diff --git a/src/Internal/Tools/Decode.elm b/src/Internal/Tools/DecodeExtra.elm similarity index 98% rename from src/Internal/Tools/Decode.elm rename to src/Internal/Tools/DecodeExtra.elm index c0ea7b2..6460233 100644 --- a/src/Internal/Tools/Decode.elm +++ b/src/Internal/Tools/DecodeExtra.elm @@ -1,4 +1,4 @@ -module Internal.Tools.Decode exposing +module Internal.Tools.DecodeExtra exposing ( opField, opFieldWithDefault , map9, map10, map11 ) diff --git a/src/Internal/Tools/Encode.elm b/src/Internal/Tools/EncodeExtra.elm similarity index 94% rename from src/Internal/Tools/Encode.elm rename to src/Internal/Tools/EncodeExtra.elm index 53649d9..726d9b8 100644 --- a/src/Internal/Tools/Encode.elm +++ b/src/Internal/Tools/EncodeExtra.elm @@ -1,4 +1,4 @@ -module Internal.Tools.Encode exposing (maybeObject) +module Internal.Tools.EncodeExtra exposing (maybeObject) {-| diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index f2e4fdb..49a178d 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -4,7 +4,7 @@ module Internal.Tools.Hashdict exposing , isEmpty, member, memberKey, get, size, isEqual , keys, values, toList, fromList , rehash, union - , encode, decoder, softDecoder + , coder, encode, decoder, softDecoder ) {-| This module abstracts the `Dict` type with one function that assigns a @@ -40,13 +40,14 @@ This allows you to store values based on an externally defined identifier. ## JSON coders -@docs encode, decoder, softDecoder +@docs coder, encode, decoder, softDecoder -} import FastDict as Dict exposing (Dict) -import Json.Decode as D -import Json.Encode as E +import Internal.Config.Log as Log +import Internal.Config.Text as Text +import Internal.Tools.Json as Json {-| A dictionary of keys and values where each key is defined by its value. For @@ -80,25 +81,43 @@ type Hashdict a } +{-| Define how Hashdict can be encoded to and decoded from a JSON object. +-} +coder : (a -> String) -> Json.Coder a -> Json.Coder (Hashdict a) +coder f c1 = + Json.andThen + { name = Text.docs.hashdict.name + , description = Text.docs.hashdict.description + , forth = + -- TODO: Implement fastDictWithFilter function + \items -> + case List.filter (\( k, v ) -> f v /= k) (Dict.toList items) of + [] -> + { hash = f, values = items } + |> Hashdict + |> Json.succeed + |> (|>) [] + + wrongHashes -> + wrongHashes + |> List.map Tuple.first + |> List.map ((++) "Invalid hash") + |> List.map Log.log.error + |> Json.fail Text.invalidHashInHashdict + , back = \(Hashdict h) -> h.values + , failure = + Text.failures.hashdict + } + (Json.fastDict c1) + + {-| Decode a hashdict from a JSON value. To create a hashdict, you are expected to insert a hash function. If the hash function doesn't properly hash the values as expected, the decoder will fail to decode the hashdict. -} -decoder : (a -> String) -> D.Decoder a -> D.Decoder (Hashdict a) -decoder f xDecoder = - D.keyValuePairs xDecoder - |> D.andThen - (\items -> - if List.all (\( hash, value ) -> f value == hash) items then - items - |> Dict.fromList - |> (\d -> { hash = f, values = d }) - |> Hashdict - |> D.succeed - - else - D.fail "Hash function fails to properly hash all values" - ) +decoder : (a -> String) -> Json.Coder a -> Json.Decoder (Hashdict a) +decoder f c1 = + Json.decode (coder f c1) {-| Create an empty hashdict. @@ -112,12 +131,9 @@ empty hash = cannot be universally converted to JSON, so it is up to you to preserve that hash function! -} -encode : (a -> E.Value) -> Hashdict a -> E.Value -encode encodeX (Hashdict h) = - h.values - |> Dict.toList - |> List.map (Tuple.mapSecond encodeX) - |> E.object +encode : Json.Coder a -> Json.Encoder (Hashdict a) +encode c1 (Hashdict h) = + Json.encode (coder h.hash c1) (Hashdict h) {-| Convert an association list into a hashdict. @@ -240,10 +256,20 @@ size (Hashdict h) = used hash function, (or if you simply do not care) you can use this function to decode and rehash the Hashdict using your new hash function. -} -softDecoder : (a -> String) -> D.Decoder a -> D.Decoder (Hashdict a) -softDecoder f xDecoder = - D.keyValuePairs xDecoder - |> D.map (List.map Tuple.second >> fromList f) +softDecoder : (a -> String) -> Json.Coder a -> Json.Decoder (Hashdict a) +softDecoder f c1 = + c1 + |> Json.fastDict + |> Json.map + { name = Text.docs.hashdict.name + , description = Text.docs.hashdict.description + , forth = + \items -> + Hashdict { hash = f, values = items } + |> rehash f + , back = \(Hashdict h) -> h.values + } + |> Json.decode {-| Convert a hashdict into an association list of key-value pairs, sorted by diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm new file mode 100644 index 0000000..1a9ca12 --- /dev/null +++ b/src/Internal/Tools/Json.elm @@ -0,0 +1,1159 @@ +module Internal.Tools.Json exposing + ( Coder, string, bool, int, float, value + , Encoder, encode, Decoder, decode, Value + , succeed, fail, andThen, lazy, map + , Docs(..), RequiredField(..), toDocs + , list, slowDict, fastDict, maybe + , Field, field + , object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 + ) + +{-| + + +# JSON module + +The JSON module wrapper helps define JSON encoders and decoders in a structural +manner. + +While developing the Elm SDK, a huge amount of encoders and decoders had to +be written that also gained more requirements as the project got more complex: + +1. Objects needed JSON encoders +2. Objects needed JSON decoders +3. Objects needed documentation about how their JSON encodes/decodes +4. Objects needed additional logs in case of special decoded values + +To meet all these requirements, this module helps translate between JSON and +data types. Because this module uses dynamic builder types, this also means it +is relatively easy to write documentation for any data type that uses this +module to build its encoders and decoders. + +@docs Coder, string, bool, int, float, value + + +## JSON Coding + +@docs Encoder, encode, Decoder, decode, Value + + +## Optional coding + +@docs succeed, fail, andThen, lazy, map + + +## Documentation + +@docs Docs, RequiredField, toDocs + + +## Data types + +@docs list, slowDict, fastDict, maybe + + +## Objects + +This section creates objects that can be (re)used in the library's JSON +specification. For this, the user needs to construct fields for the object +first. + +@docs Field, field + +Once all fields are constructed, the user can create JSON objects. + +@docs object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 + +-} + +import Dict as SlowDict +import FastDict +import Internal.Config.Log exposing (Log) +import Internal.Tools.DecodeExtra as D +import Internal.Tools.EncodeExtra as E +import Json.Decode as D +import Json.Encode as E + + +{-| A field of type `a` as a subtype of an object `object`. + +In concrete terms, to construct a data type + + type alias User = + { name : String + , age : Int + , hobbies : List String + } + +The user needs to construct the field types: + + - `Field String User`, + - `Field Int User`, + - and `Field (List String) User`. + +-} +type Field a object + = Field + { fieldName : String + , description : List String + , encoder : a -> Maybe E.Value + , decoder : D.Decoder ( a, List Log ) + , docs : Docs + , toField : object -> a + , requiredness : RequiredField + } + + +{-| Builder type that helps create JSON encoders, JSON decoders, data type +documentation and various other data types. +-} +type Coder a + = Coder + { encoder : a -> E.Value + , decoder : D.Decoder ( a, List Log ) + , docs : Docs + } + + +type DecodeResult a + = Success ( a, List Log ) + | Fail ( String, List Log ) + + +{-| Decoder type that describes the format of a JSON value that can be decoded +as a given type. +-} +type alias Decoder a = + D.Decoder ( a, List Log ) + + +type alias Descriptive a = + { a | name : String, description : List String } + + +{-| Structure of JSON documentation. It is up to an external module to turn the +documentation structure into a readable format. +-} +type Docs + = DocsBool + | DocsDict Docs + | DocsFloat + | DocsInt + | DocsLazy (() -> Docs) + | DocsList Docs + | DocsMap (Descriptive { content : Docs }) + | DocsObject + (Descriptive + { keys : + List + { field : String + , description : List String + , required : RequiredField + , content : Docs + } + } + ) + | DocsOptional Docs + | DocsRiskyMap (Descriptive { content : Docs, failure : List String }) + | DocsString + | DocsValue + + +{-| Encoder type that takes an input and converts it to a JSON value. +-} +type alias Encoder a = + a -> E.Value + + +{-| Value that tells whether an object field is required to be included. If it +is not required, it can either be omitted - or a given default will be assumed. +The given default is a string representation, not the actual value. +-} +type RequiredField + = RequiredField + | OptionalField + | OptionalFieldWithDefault String + + +{-| Represents an arbitary JavaScript value. +-} +type alias Value = + E.Value + + +{-| Continue decoding a result. This function tests if it meets the criteria, +and then it manages the results. +-} +andThen : Descriptive { back : b -> a, forth : a -> DecodeResult b, failure : List String } -> Coder a -> Coder b +andThen { name, description, failure, back, forth } (Coder old) = + Coder + { encoder = back >> old.encoder + , decoder = + old.decoder + |> D.andThen + (\result -> + case result of + ( out, logs ) -> + case forth out of + Success x -> + x + |> Tuple.mapSecond (List.append logs) + |> D.succeed + + Fail ( f, _ ) -> + D.fail f + ) + , docs = + DocsRiskyMap + { name = name + , description = description + , content = old.docs + , failure = failure + } + } + + +{-| Define a boolean value. +-} +bool : Coder Bool +bool = + Coder + { encoder = E.bool + , decoder = D.map empty D.bool + , docs = DocsBool + } + + +{-| Get a JSON coder's decode value +-} +decode : Coder a -> D.Decoder ( a, List Log ) +decode (Coder data) = + data.decoder + + +{-| Generate documentation from a Coder definition. +-} +toDocs : Coder a -> Docs +toDocs (Coder data) = + data.docs + + +{-| Create a tuple with no logs +-} +empty : a -> ( a, List Log ) +empty x = + ( x, [] ) + + +{-| Get a JSON coder's encode value + + + text : Json.Encode.Value + text = + encode string "test" + + -- == Json.Encode.string "test" + +-} +encode : Coder a -> (a -> E.Value) +encode (Coder data) = + data.encoder + + +{-| Fail a decoder. +-} +fail : String -> List Log -> DecodeResult a +fail reason logs = + Fail ( reason, logs ) + + +{-| Define a fast dict. The dict can only have strings as keys. +-} +fastDict : Coder value -> Coder (FastDict.Dict String value) +fastDict (Coder old) = + Coder + { encoder = FastDict.toCoreDict >> E.dict identity old.encoder + , decoder = + old.decoder + |> D.keyValuePairs + |> D.map + (\items -> + ( items + |> List.map (Tuple.mapSecond Tuple.first) + |> FastDict.fromList + , items + |> List.map Tuple.second + |> List.concatMap Tuple.second + ) + ) + , docs = DocsDict old.docs + } + + +{-| Create a new field using any of the three provided options. + +For example, suppose we are creating a `Field String User` to represent the +`name` field in + + type alias User = + { name : String + , age : Int + , hobbies : List String + } + +then the following field type would be used: + + field.required + { fieldName = "name" -- Field name when encoded into JSON + , toField = .name + , description = + [ "This description describes this field's information content." + , "Here's another paragraph!" + ] + , coder = string + } + +Suppose the JSO isn't obligated to provide a list of hobbies, and the list would +by default be overriden with an empty list, then we would use the following +field type: + + field.optional.withDefault + { fieldName = "hobbies" + , toField = .hobbies + , description = + [ "The hobbies of the person. Can be omitted." + ] + , coder = list string + , default = ( [], [] ) -- The `List Log` can be inserted in case you wish to insert a message when relying on a default + , defaultToString = always "[]" -- Default converted to a string + } + +-} +field : + { required : { fieldName : String, toField : object -> a, description : List String, coder : Coder a } -> Field a object + , optional : + { value : { fieldName : String, toField : object -> Maybe a, description : List String, coder : Coder a } -> Field (Maybe a) object + , withDefault : { fieldName : String, toField : object -> a, description : List String, coder : Coder a, default : ( a, List Log ), defaultToString : a -> String } -> Field a object + } + } +field = + { required = + \{ fieldName, toField, description, coder } -> + case coder of + Coder { encoder, decoder, docs } -> + Field + { fieldName = fieldName + , toField = toField + , description = description + , encoder = encoder >> Maybe.Just + , decoder = D.field fieldName decoder + , docs = docs + , requiredness = RequiredField + } + , optional = + { value = + \{ fieldName, toField, description, coder } -> + case coder of + Coder { encoder, decoder, docs } -> + Field + { fieldName = fieldName + , toField = toField + , description = description + , encoder = Maybe.map encoder + , decoder = + decoder + |> D.opField fieldName + |> D.map + (\out -> + case out of + Just ( v, l ) -> + ( Just v, l ) + + Nothing -> + ( Nothing, [] ) + ) + , docs = docs + , requiredness = OptionalField + } + , withDefault = + \{ fieldName, toField, description, coder, default, defaultToString } -> + case coder of + Coder { encoder, decoder, docs } -> + Field + { fieldName = fieldName + , toField = toField + , description = description + , encoder = + \o -> + -- If the value matches the default, do not record + if o == Tuple.first default then + Nothing + + else + Maybe.Just (encoder o) + , decoder = D.opFieldWithDefault fieldName default decoder + , docs = docs + , requiredness = + default + |> Tuple.first + |> defaultToString + |> OptionalFieldWithDefault + } + } + } + + +{-| Define a float value. +-} +float : Coder Float +float = + Coder + { encoder = E.float + , decoder = D.map empty D.float + , docs = DocsFloat + } + + +{-| Define an int value. +-} +int : Coder Int +int = + Coder + { encoder = E.int + , decoder = D.map empty D.int + , docs = DocsInt + } + + +{-| Define a lazy coder. This is useful when defining recursive structures. +-} +lazy : (() -> Coder value) -> Coder value +lazy f = + Coder + { encoder = + \v -> + case f () of + Coder old -> + old.encoder v + , decoder = + D.lazy + (\() -> + case f () of + Coder old -> + old.decoder + ) + , docs = DocsLazy (f >> toDocs) + } + + +{-| Define a list. +-} +list : Coder a -> Coder (List a) +list (Coder old) = + Coder + { encoder = E.list old.encoder + , decoder = + old.decoder + |> D.list + |> D.map + (\items -> + ( List.map Tuple.first items + , List.concatMap Tuple.second items + ) + ) + , docs = DocsList old.docs + } + + +{-| Map a value. + +Given that the value needs to be both encoded and decoded, the map function +should be invertible. + +-} +map : Descriptive { back : b -> a, forth : a -> b } -> Coder a -> Coder b +map { name, description, back, forth } (Coder old) = + Coder + { encoder = back >> old.encoder + , decoder = D.map (Tuple.mapFirst forth) old.decoder + , docs = + DocsMap + { name = name, description = description, content = old.docs } + } + + +{-| Define a maybe value. + +NOTE: most of the time, you wish to avoid this function! Make sure to look at +objects instead. + +-} +maybe : Coder a -> Coder (Maybe a) +maybe (Coder old) = + Coder + { encoder = Maybe.map old.encoder >> Maybe.withDefault E.null + , decoder = + old.decoder + |> D.nullable + |> D.map + (\out -> + case out of + Just ( v, logs ) -> + ( Just v, logs ) + + Nothing -> + empty Nothing + ) + , docs = DocsOptional old.docs + } + + +{-| Use an objectEncoder to encode a list of items into a single object. +-} +objectEncoder : List ( String, object -> Maybe E.Value ) -> object -> E.Value +objectEncoder items object = + items + |> List.map (Tuple.mapSecond (\f -> f object)) + |> E.maybeObject + + +{-| Define an object with 2 keys + + type alias Human = + { name : String, age : Maybe Int } + + humanCoder : Coder Human + humanCoder = + object2 + { name = "Human" + , description = + [ "Documentation description of the human type." + ] + , init = Human + } + (field.required + { fieldName = "name" + , toField = .name + , description = + [ "Human's name." + ] + , coder = string + } + ) + (field.optional.value + { fieldName = "age" + , toField = .age + , description = + [ "(Optional) human's age" + ] + , coder = int + } + ) + +-} +object2 : + Descriptive { init : a -> b -> object } + -> Field a object + -> Field b object + -> Coder object +object2 { name, description, init } fa fb = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + ] + , decoder = + D.map2 + (\( a, la ) ( b, lb ) -> + ( init a b + , List.concat [ la, lb ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + ] + } + } + + +{-| Define an object with 3 keys +-} +object3 : + Descriptive { init : a -> b -> c -> object } + -> Field a object + -> Field b object + -> Field c object + -> Coder object +object3 { name, description, init } fa fb fc = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + ] + , decoder = + D.map3 + (\( a, la ) ( b, lb ) ( c, lc ) -> + ( init a b c + , List.concat [ la, lb, lc ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + ] + } + } + + +{-| Define an object with 4 keys +-} +object4 : + Descriptive { init : a -> b -> c -> d -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Coder object +object4 { name, description, init } fa fb fc fd = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + ] + , decoder = + D.map4 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) -> + ( init a b c d + , List.concat [ la, lb, lc, ld ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + ] + } + } + + +{-| Define an object with 5 keys +-} +object5 : + Descriptive { init : a -> b -> c -> d -> e -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Coder object +object5 { name, description, init } fa fb fc fd fe = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + ] + , decoder = + D.map5 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) -> + ( init a b c d e + , List.concat [ la, lb, lc, ld, le ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + ] + } + } + + +{-| Define an object with 6 keys +-} +object6 : + Descriptive { init : a -> b -> c -> d -> e -> f -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Coder object +object6 { name, description, init } fa fb fc fd fe ff = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + ] + , decoder = + D.map6 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) -> + ( init a b c d e f + , List.concat [ la, lb, lc, ld, le, lf ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + ] + } + } + + +{-| Define an object with 7 keys +-} +object7 : + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Coder object +object7 { name, description, init } fa fb fc fd fe ff fg = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + ] + , decoder = + D.map7 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) -> + ( init a b c d e f g + , List.concat [ la, lb, lc, ld, le, lf, lg ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + ] + } + } + + +{-| Define an object with 8 keys +-} +object8 : + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> Coder object +object8 { name, description, init } fa fb fc fd fe ff fg fh = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + ] + , decoder = + D.map8 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) -> + ( init a b c d e f g h + , List.concat [ la, lb, lc, ld, le, lf, lg, lh ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + ] + } + } + + +{-| Define an object with 9 keys +-} +object9 : + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> Field i object + -> Coder object +object9 { name, description, init } fa fb fc fd fe ff fg fh fi = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + , toEncodeField fi + ] + , decoder = + D.map9 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) -> + ( init a b c d e f g h i + , List.concat [ la, lb, lc, ld, le, lf, lg, lh, li ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + (toDecoderField fi) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + , toDocsField fi + ] + } + } + + +{-| Define an object with 10 keys +-} +object10 : + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> Field i object + -> Field j object + -> Coder object +object10 { name, description, init } fa fb fc fd fe ff fg fh fi fj = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + , toEncodeField fi + , toEncodeField fj + ] + , decoder = + D.map10 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) -> + ( init a b c d e f g h i j + , List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + (toDecoderField fi) + (toDecoderField fj) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + , toDocsField fi + , toDocsField fj + ] + } + } + + +{-| Define an object with 11 keys +-} +object11 : + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> Field i object + -> Field j object + -> Field k object + -> Coder object +object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + , toEncodeField fi + , toEncodeField fj + , toEncodeField fk + ] + , decoder = + D.map11 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) -> + ( init a b c d e f g h i j k + , List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + (toDecoderField fi) + (toDecoderField fj) + (toDecoderField fk) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + , toDocsField fi + , toDocsField fj + , toDocsField fk + ] + } + } + + +{-| Define a slow dict from the `elm/core` library. +-} +slowDict : Coder value -> Coder (SlowDict.Dict String value) +slowDict (Coder data) = + Coder + { encoder = E.dict identity data.encoder + , decoder = + data.decoder + |> D.keyValuePairs + |> D.map + (\items -> + ( items + |> List.map (Tuple.mapSecond Tuple.first) + |> SlowDict.fromList + , items + |> List.map Tuple.second + |> List.concatMap Tuple.second + ) + ) + , docs = DocsDict data.docs + } + + +{-| Define a string value. +-} +string : Coder String +string = + Coder + { encoder = E.string + , decoder = D.map empty D.string + , docs = DocsString + } + + +{-| Succeed a decoder. +-} +succeed : a -> List Log -> DecodeResult a +succeed x logs = + Success ( x, logs ) + + +{-| Turn a Field type into a usable JSON decoder +-} +toDecoderField : Field a object -> D.Decoder ( a, List Log ) +toDecoderField (Field data) = + data.decoder + + +{-| Turn a Field type into a descriptive field documentation +-} +toDocsField : Field a object -> { field : String, description : List String, required : RequiredField, content : Docs } +toDocsField x = + case x of + Field { fieldName, description, docs, requiredness } -> + { field = fieldName + , description = description + , required = requiredness + , content = docs + } + + +{-| Turn a Field type into a usable object for a maybeObject type +-} +toEncodeField : Field a object -> ( String, object -> Maybe E.Value ) +toEncodeField (Field data) = + ( data.fieldName, data.toField >> data.encoder ) + + +{-| Do not do anything useful with a JSON value, just bring it to Elm as a +JavaScript value. +-} +value : Coder Value +value = + Coder + { encoder = identity + , decoder = D.map (\v -> ( v, [] )) D.value + , docs = DocsValue + } diff --git a/src/Internal/Tools/Mashdict.elm b/src/Internal/Tools/Mashdict.elm index 22c27a8..1b570ab 100644 --- a/src/Internal/Tools/Mashdict.elm +++ b/src/Internal/Tools/Mashdict.elm @@ -4,7 +4,7 @@ module Internal.Tools.Mashdict exposing , isEmpty, member, memberKey, get, size, isEqual , keys, values, toList, fromList , rehash, union - , encode, decoder, softDecoder + , coder, encode, decoder, softDecoder ) {-| @@ -48,13 +48,14 @@ In general, you are advised to learn more about the ## JSON coders -@docs encode, decoder, softDecoder +@docs coder, encode, decoder, softDecoder -} import FastDict as Dict exposing (Dict) -import Json.Decode as D -import Json.Encode as E +import Internal.Config.Log as Log +import Internal.Config.Text as Text +import Internal.Tools.Json as Json {-| A dictionary of keys and values where each key is defined by its value, but @@ -92,25 +93,41 @@ type Mashdict a } +{-| Define how a Mashdict can be encoded to and decoded from a JSON object. +-} +coder : (a -> Maybe String) -> Json.Coder a -> Json.Coder (Mashdict a) +coder f c1 = + Json.andThen + { name = Text.docs.mashdict.name + , description = Text.docs.mashdict.description + , forth = + \items -> + case List.filter (\( k, v ) -> f v /= Just k) (Dict.toList items) of + [] -> + { hash = f, values = items } + |> Mashdict + |> Json.succeed + |> (|>) [] + + wrongHashes -> + wrongHashes + |> List.map Tuple.first + |> List.map ((++) "Invalid hash") + |> List.map Log.log.error + |> Json.fail Text.invalidHashInMashdict + , back = \(Mashdict h) -> h.values + , failure = Text.failures.mashdict + } + (Json.fastDict c1) + + {-| Decode a mashdict from a JSON value. To create a mashdict, you are expected to insert a hash function. If the hash function doesn't properly hash the values as expected, the decoder will fail to decode the mashdict. -} -decoder : (a -> Maybe String) -> D.Decoder a -> D.Decoder (Mashdict a) -decoder f xDecoder = - D.keyValuePairs xDecoder - |> D.andThen - (\items -> - if List.all (\( hash, value ) -> f value == Just hash) items then - items - |> Dict.fromList - |> (\d -> { hash = f, values = d }) - |> Mashdict - |> D.succeed - - else - D.fail "Hash function fails to properly hash all values" - ) +decoder : (a -> Maybe String) -> Json.Coder a -> Json.Decoder (Mashdict a) +decoder f c1 = + Json.decode (coder f c1) {-| Create an empty mashdict. @@ -124,12 +141,9 @@ empty hash = cannot be universally converted to JSON, so it is up to you to preserve that hash function! -} -encode : (a -> E.Value) -> Mashdict a -> E.Value -encode encodeX (Mashdict h) = - h.values - |> Dict.toList - |> List.map (Tuple.mapSecond encodeX) - |> E.object +encode : Json.Coder a -> Json.Encoder (Mashdict a) +encode c1 (Mashdict h) = + Json.encode (coder h.hash c1) (Mashdict h) {-| Convert an association list into a mashdict. @@ -266,10 +280,20 @@ size (Mashdict h) = used hash function, (or if you simply do not care) you can use this function to decode and rehash the Mashdict using your new hash function. -} -softDecoder : (a -> Maybe String) -> D.Decoder a -> D.Decoder (Mashdict a) -softDecoder f xDecoder = - D.keyValuePairs xDecoder - |> D.map (List.map Tuple.second >> fromList f) +softDecoder : (a -> Maybe String) -> Json.Coder a -> Json.Decoder (Mashdict a) +softDecoder f c1 = + c1 + |> Json.fastDict + |> Json.map + { name = Text.docs.hashdict.name + , description = Text.docs.hashdict.description + , forth = + \items -> + Mashdict { hash = f, values = items } + |> rehash f + , back = \(Mashdict h) -> h.values + } + |> Json.decode {-| Convert a mashdict into an association list of key-value pairs, sorted by diff --git a/src/Internal/Tools/Timestamp.elm b/src/Internal/Tools/Timestamp.elm index a0ed35c..0f96a77 100644 --- a/src/Internal/Tools/Timestamp.elm +++ b/src/Internal/Tools/Timestamp.elm @@ -1,6 +1,6 @@ module Internal.Tools.Timestamp exposing ( Timestamp - , encode, decoder + , coder, encode, decoder ) {-| The Timestamp module is a simplification of the Timestamp as delivered by @@ -14,12 +14,11 @@ elm/time. This module offers ways to work with the timestamp in meaningful ways. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} -import Json.Decode as D -import Json.Encode as E +import Internal.Tools.Json as Json import Time @@ -29,15 +28,30 @@ type alias Timestamp = Time.Posix +{-| Create a Json coder +-} +coder : Json.Coder Timestamp +coder = + Json.map + { back = Time.posixToMillis + , forth = Time.millisToPosix + , name = "Milliseconds to POSIX" + , description = + [ "Converts the timestamp from milliseconds to a POSIX timestamp." + ] + } + Json.int + + {-| Encode a timestamp into a JSON value. -} -encode : Timestamp -> E.Value +encode : Json.Encoder Timestamp encode = - Time.posixToMillis >> E.int + Json.encode coder {-| Decode a timestamp from a JSON value. -} -decoder : D.Decoder Timestamp +decoder : Json.Decoder Timestamp decoder = - D.map Time.millisToPosix D.int + Json.decode coder diff --git a/src/Internal/Values/Context.elm b/src/Internal/Values/Context.elm index 88efd33..d8f67e8 100644 --- a/src/Internal/Values/Context.elm +++ b/src/Internal/Values/Context.elm @@ -1,5 +1,5 @@ module Internal.Values.Context exposing - ( Context, init, encode, decoder + ( Context, init, coder, encode, decoder , APIContext, apiFormat , setAccessToken, getAccessToken , setBaseUrl, getBaseUrl @@ -14,7 +14,7 @@ the Matrix API. ## Context -@docs Context, init, encode, decoder +@docs Context, init, coder, encode, decoder ## APIContext @@ -50,10 +50,8 @@ information that can be inserted. -} import Internal.Config.Leaks as L -import Internal.Tools.Decode as D -import Internal.Tools.Encode as E -import Json.Decode as D -import Json.Encode as E +import Internal.Config.Text as Text +import Internal.Tools.Json as Json {-| The Context type stores all the information in the Vault. This data type is @@ -97,33 +95,78 @@ apiFormat context = } +{-| Define how a Context can be encoded to and decoded from a JSON object. +-} +coder : Json.Coder Context +coder = + Json.object7 + { name = Text.docs.context.name + , description = Text.docs.context.description + , init = Context + } + (Json.field.optional.value + { fieldName = "accessToken" + , toField = .accessToken + , description = Text.fields.context.accessToken + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "baseUrl" + , toField = .baseUrl + , description = Text.fields.context.baseUrl + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "password" + , toField = .password + , description = Text.fields.context.password + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "refreshToken" + , toField = .refreshToken + , description = Text.fields.context.refreshToken + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "username" + , toField = .username + , description = Text.fields.context.username + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "transaction" + , toField = .transaction + , description = Text.fields.context.transaction + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "versions" + , toField = .versions + , description = Text.fields.context.versions + , coder = Json.list Json.string + } + ) + + {-| Decode a Context type from a JSON value. -} -decoder : D.Decoder Context +decoder : Json.Decoder Context decoder = - D.map7 Context - (D.opField "accessToken" D.string) - (D.opField "baseUrl" D.string) - (D.opField "password" D.string) - (D.opField "refreshToken" D.string) - (D.opField "username" D.string) - (D.opField "transaction" D.string) - (D.opField "versions" (D.list D.string)) + Json.decode coder {-| Encode a Context type into a JSON value. -} -encode : Context -> E.Value -encode context = - E.maybeObject - [ ( "accessToken", Maybe.map E.string context.accessToken ) - , ( "baseUrl", Maybe.map E.string context.baseUrl ) - , ( "password", Maybe.map E.string context.password ) - , ( "refreshToken", Maybe.map E.string context.refreshToken ) - , ( "username", Maybe.map E.string context.username ) - , ( "transaction", Maybe.map E.string context.transaction ) - , ( "versions", Maybe.map (E.list E.string) context.versions ) - ] +encode : Json.Encoder Context +encode = + Json.encode coder {-| A basic, untouched version of the Context, containing no information. diff --git a/src/Internal/Values/Envelope.elm b/src/Internal/Values/Envelope.elm index dbbc815..e8cb64e 100644 --- a/src/Internal/Values/Envelope.elm +++ b/src/Internal/Values/Envelope.elm @@ -4,7 +4,7 @@ module Internal.Values.Envelope exposing , Settings, mapSettings, extractSettings , mapContext , getContent, extract - , encode, decoder + , coder, encode, decoder ) {-| The Envelope module wraps existing data types with lots of values and @@ -38,17 +38,14 @@ settings that can be adjusted manually. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} -import Internal.Config.Default as Default -import Internal.Tools.Decode as D -import Internal.Tools.Encode as E +import Internal.Config.Text as Text +import Internal.Tools.Json as Json import Internal.Values.Context as Context exposing (Context) import Internal.Values.Settings as Settings -import Json.Decode as D -import Json.Encode as E {-| There are lots of different data types in the Elm SDK, and many of them @@ -71,28 +68,54 @@ type alias Settings = Settings.Settings +{-| Define how an Envelope can be encoded to and decoded from a JSON object. +-} +coder : Json.Coder a -> Json.Coder (Envelope a) +coder c1 = + Json.object3 + { name = Text.docs.envelope.name + , description = Text.docs.envelope.description + , init = Envelope + } + (Json.field.required + { fieldName = "content" + , toField = .content + , description = Text.fields.envelope.content + , coder = c1 + } + ) + (Json.field.required + { fieldName = "context" + , toField = .context + , description = Text.fields.envelope.context + , coder = Context.coder + } + ) + (Json.field.optional.withDefault + { fieldName = "settings" + , toField = .settings + , description = Text.fields.envelope.settings + , coder = Settings.coder + , default = Tuple.pair Settings.init [] + , defaultToString = always "" + } + ) + + {-| Decode an enveloped type from a JSON value. The decoder also imports any potential tokens, values and settings included in the JSON. -} -decoder : D.Decoder a -> D.Decoder (Envelope a) -decoder xDecoder = - D.map3 Envelope - (D.field "content" xDecoder) - (D.field "context" Context.decoder) - (D.field "settings" Settings.decoder) +decoder : Json.Coder a -> Json.Decoder (Envelope a) +decoder c1 = + Json.decode (coder c1) {-| Encode an enveloped type into a JSON value. The function encodes all non-standard settings, tokens and values. -} -encode : (a -> E.Value) -> Envelope a -> E.Value -encode encodeX data = - E.object - [ ( "content", encodeX data.content ) - , ( "context", Context.encode data.context ) - , ( "settings", Settings.encode data.settings ) - , ( "version", E.string Default.currentVersion ) - ] +encode : Json.Coder a -> Json.Encoder (Envelope a) +encode c1 = + Json.encode (coder c1) {-| Map a function, then get its content. This is useful for getting information diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index a3a37bb..3a52bcf 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -1,7 +1,7 @@ module Internal.Values.Event exposing ( Event , UnsignedData(..), age, prevContent, redactedBecause, transactionId - , encode, decoder + , coder, encode, decoder ) {-| @@ -22,22 +22,19 @@ of a room. ## JSON Coder -@docs encode, decoder +@docs coder, encode, decoder -} -import Internal.Config.Default as Default -import Internal.Tools.Decode as D -import Internal.Tools.Encode as E +import Internal.Config.Text as Text +import Internal.Tools.Json as Json import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) -import Json.Decode as D -import Json.Encode as E {-| The Event type occurs everywhere on a user's timeline. -} type alias Event = - { content : E.Value + { content : Json.Value , eventId : String , originServerTs : Timestamp , roomId : String @@ -54,7 +51,7 @@ helper functions. type UnsignedData = UnsignedData { age : Maybe Int - , prevContent : Maybe E.Value + , prevContent : Maybe Json.Value , redactedBecause : Maybe Event , transactionId : Maybe String } @@ -67,66 +64,95 @@ age event = Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned +{-| Define how an Event can be encoded to and decoded from a JSON object. +-} +coder : Json.Coder Event +coder = + Json.object8 + { name = Text.docs.event.name + , description = Text.docs.event.description + , init = Event + } + (Json.field.required + { fieldName = "content" + , toField = .content + , description = Text.fields.event.content + , coder = Json.value + } + ) + (Json.field.required + { fieldName = "eventId" + , toField = .eventId + , description = Text.fields.event.eventId + , coder = Json.string + } + ) + (Json.field.required + { fieldName = "originServerTs" + , toField = .originServerTs + , description = Text.fields.event.originServerTs + , coder = Timestamp.coder + } + ) + (Json.field.required + { fieldName = "roomId" + , toField = .roomId + , description = Text.fields.event.roomId + , coder = Json.string + } + ) + (Json.field.required + { fieldName = "sender" + , toField = .sender + , description = Text.fields.event.sender + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "stateKey" + , toField = .stateKey + , description = Text.fields.event.stateKey + , coder = Json.string + } + ) + (Json.field.required + -- NOTE! | In JSON we call it `type`, not `eventType`, + -- NOTE! | so that the data is easier to read for other non-Elm + -- NOTE! | JSON parsers + { fieldName = "type" + , toField = .eventType + , description = Text.fields.event.eventType + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "unsigned" + , toField = .unsigned + , description = Text.fields.event.unsigned + , coder = unsignedCoder + } + ) + + {-| Decode an Event from a JSON value. -} -decoder : D.Decoder Event +decoder : Json.Decoder Event decoder = - D.map8 Event - (D.field "content" D.value) - (D.field "eventId" D.string) - (D.field "originServerTs" Timestamp.decoder) - (D.field "roomId" D.string) - (D.field "sender" D.string) - (D.opField "stateKey" D.string) - (D.field "eventType" D.string) - (D.opField "unsigned" decoderUnsignedData) - - -{-| Decode Unsigned Data from a JSON value. --} -decoderUnsignedData : D.Decoder UnsignedData -decoderUnsignedData = - D.map4 (\a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d }) - (D.opField "age" D.int) - (D.opField "prevContent" D.value) - (D.opField "redactedBecause" (D.lazy (\_ -> decoder))) - (D.opField "transactionId" D.string) + Json.decode coder {-| Encode an Event into a JSON value. -} -encode : Event -> E.Value -encode event = - E.maybeObject - [ ( "content", Just event.content ) - , ( "eventId", Just <| E.string event.eventId ) - , ( "originServerTs", Just <| Timestamp.encode event.originServerTs ) - , ( "roomId", Just <| E.string event.roomId ) - , ( "sender", Just <| E.string event.sender ) - , ( "stateKey", Maybe.map E.string event.stateKey ) - , ( "eventType", Just <| E.string event.eventType ) - , ( "unsigned", Maybe.map encodeUnsignedData event.unsigned ) - , ( "version", Just <| E.string Default.currentVersion ) - ] - - -{-| Encode Unsigned Data into a JSON value. --} -encodeUnsignedData : UnsignedData -> E.Value -encodeUnsignedData (UnsignedData data) = - E.maybeObject - [ ( "age", Maybe.map E.int data.age ) - , ( "prevContent", data.prevContent ) - , ( "redactedBecause", Maybe.map encode data.redactedBecause ) - , ( "transactionId", Maybe.map E.string data.transactionId ) - ] +encode : Json.Encoder Event +encode = + Json.encode coder {-| Determine the previous `content` value for this event. This field is only a `Just value` if the event is a state event, and the Matrix Vault has permission to see the previous content. -} -prevContent : Event -> Maybe E.Value +prevContent : Event -> Maybe Json.Value prevContent event = Maybe.andThen (\(UnsignedData data) -> data.prevContent) event.unsigned @@ -145,3 +171,40 @@ display the original transaction id used for the event. transactionId : Event -> Maybe String transactionId event = Maybe.andThen (\(UnsignedData data) -> data.transactionId) event.unsigned + + +unsignedCoder : Json.Coder UnsignedData +unsignedCoder = + Json.object4 + { name = Text.docs.unsigned.name + , description = Text.docs.unsigned.description + , init = \a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d } + } + (Json.field.optional.value + { fieldName = "age" + , toField = \(UnsignedData data) -> data.age + , description = Text.fields.unsigned.age + , coder = Json.int + } + ) + (Json.field.optional.value + { fieldName = "prevContent" + , toField = \(UnsignedData data) -> data.prevContent + , description = Text.fields.unsigned.prevContent + , coder = Json.value + } + ) + (Json.field.optional.value + { fieldName = "redactedBecause" + , toField = \(UnsignedData data) -> data.redactedBecause + , description = Text.fields.unsigned.redactedBecause + , coder = Json.lazy (\_ -> coder) + } + ) + (Json.field.optional.value + { fieldName = "transactionId" + , toField = \(UnsignedData data) -> data.transactionId + , description = Text.fields.unsigned.transactionId + , coder = Json.string + } + ) diff --git a/src/Internal/Values/Settings.elm b/src/Internal/Values/Settings.elm index f9a266a..4696b7a 100644 --- a/src/Internal/Values/Settings.elm +++ b/src/Internal/Values/Settings.elm @@ -1,6 +1,6 @@ module Internal.Values.Settings exposing ( Settings, init - , encode, decoder + , coder, encode, decoder ) {-| @@ -16,15 +16,13 @@ data types. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} import Internal.Config.Default as Default -import Internal.Tools.Decode as D -import Internal.Tools.Encode as E -import Json.Decode as D -import Json.Encode as E +import Internal.Config.Text as Text +import Internal.Tools.Json as Json {-| Custom settings that can be manipulated by the user. These serve as a @@ -41,46 +39,56 @@ type alias Settings = } +{-| Define how a Settings type can be encoded to and decoded from a JSON object. +-} +coder : Json.Coder Settings +coder = + Json.object3 + { name = Text.docs.settings.name + , description = Text.docs.settings.description + , init = Settings + } + (Json.field.optional.withDefault + { fieldName = "currentVersion" + , toField = .currentVersion + , description = Text.fields.settings.currentVersion + , coder = Json.string + , default = Tuple.pair Default.currentVersion [] + , defaultToString = identity + } + ) + (Json.field.optional.withDefault + { fieldName = "deviceName" + , toField = .deviceName + , description = Text.fields.settings.deviceName + , coder = Json.string + , default = Tuple.pair Default.deviceName [] + , defaultToString = identity + } + ) + (Json.field.optional.withDefault + { fieldName = "syncTime" + , toField = .syncTime + , description = Text.fields.settings.syncTime + , coder = Json.int + , default = Tuple.pair Default.syncTime [] + , defaultToString = String.fromInt + } + ) + + {-| Decode settings from a JSON value. -} -decoder : D.Decoder Settings +decoder : Json.Decoder Settings decoder = - D.map3 Settings - (D.opFieldWithDefault "currentVersion" Default.currentVersion D.string) - (D.opFieldWithDefault "deviceName" Default.deviceName D.string) - (D.opFieldWithDefault "syncTime" Default.syncTime D.int) + Json.decode coder {-| Encode the settings into a JSON value. -} -encode : Settings -> E.Value -encode settings = - let - differentFrom : b -> b -> Maybe b - differentFrom defaultValue currentValue = - if currentValue == defaultValue then - Nothing - - else - Just currentValue - in - E.maybeObject - [ ( "currentVersion" - , settings.currentVersion - |> differentFrom Default.currentVersion - |> Maybe.map E.string - ) - , ( "deviceName" - , settings.deviceName - |> differentFrom Default.deviceName - |> Maybe.map E.string - ) - , ( "syncTime" - , settings.syncTime - |> differentFrom Default.syncTime - |> Maybe.map E.int - ) - ] +encode : Json.Encoder Settings +encode = + Json.encode coder {-| Create a new Settings module based on default values diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm index 46282aa..0517d60 100644 --- a/src/Internal/Values/StateManager.elm +++ b/src/Internal/Values/StateManager.elm @@ -3,7 +3,7 @@ module Internal.Values.StateManager exposing , empty, singleton, insert, remove, append , isEmpty, member, memberKey, get, size, isEqual , keys, values, fromList, toList - , encode, decoder + , coder, encode, decoder ) {-| The StateManager tracks the room state based on events, their event types @@ -34,15 +34,15 @@ dictionary-like experience to navigate through the Matrix room state. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} import FastDict as Dict exposing (Dict) +import Internal.Config.Text as Text +import Internal.Tools.Json as Json import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) import Internal.Values.Event as Event exposing (Event) -import Json.Decode as D -import Json.Encode as E {-| The StateManager manages the room state by gathering events and looking at @@ -93,15 +93,26 @@ cleanKey key (StateManager manager) = |> StateManager +{-| Define how a StateManager can be encoded to and decoded from a JSON object. +-} +coder : Json.Coder StateManager +coder = + Event.coder + |> Mashdict.coder .stateKey + |> Json.fastDict + |> Json.map + { name = Text.docs.stateManager.name + , description = Text.docs.stateManager.description + , forth = StateManager + , back = \(StateManager manager) -> manager + } + + {-| Decode a StateManager from a JSON value. -} -decoder : D.Decoder StateManager +decoder : Json.Decoder StateManager decoder = - Event.decoder - |> Mashdict.decoder .stateKey - |> D.keyValuePairs - |> D.map Dict.fromList - |> D.map StateManager + Json.decode coder {-| Create an empty StateManager. @@ -113,11 +124,9 @@ empty = {-| Encode a StateManager into a JSON value. -} -encode : StateManager -> E.Value -encode (StateManager manager) = - manager - |> Dict.toCoreDict - |> E.dict identity (Mashdict.encode Event.encode) +encode : Json.Encoder StateManager +encode = + Json.encode coder {-| Build a StateManager using a list of events. diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm index 500503c..cdfdf43 100644 --- a/tests/Test/Tools/Hashdict.elm +++ b/tests/Test/Tools/Hashdict.elm @@ -3,6 +3,7 @@ module Test.Tools.Hashdict exposing (..) import Expect import Fuzz exposing (Fuzzer) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) +import Internal.Tools.Json as Json import Internal.Values.Event as Event import Json.Decode as D import Json.Encode as E @@ -93,11 +94,11 @@ suite = "JSON encode -> JSON decode" (\indent -> Hashdict.empty identity - |> Hashdict.encode E.string + |> Json.encode (Hashdict.coder identity Json.string) |> E.encode indent - |> D.decodeString (Hashdict.decoder identity D.string) - |> Result.map (Hashdict.isEqual (Hashdict.empty String.toUpper)) - |> Expect.equal (Ok True) + |> D.decodeString (Json.decode <| Hashdict.coder identity Json.string) + |> Result.map (Tuple.mapFirst (Hashdict.isEqual (Hashdict.empty String.toUpper))) + |> Expect.equal (Ok ( True, [] )) ) ] , describe "singleton" @@ -164,11 +165,11 @@ suite = "JSON encode -> JSON decode" (\hashdict indent -> hashdict - |> Hashdict.encode Event.encode + |> Json.encode (Hashdict.coder .eventId Event.coder) |> E.encode indent - |> D.decodeString (Hashdict.decoder .eventId Event.decoder) - |> Result.map Hashdict.toList - |> Expect.equal (Ok <| Hashdict.toList hashdict) + |> D.decodeString (Json.decode <| Hashdict.coder .eventId Event.coder) + |> Result.map (Tuple.mapFirst Hashdict.toList) + |> Expect.equal (Ok ( Hashdict.toList hashdict, [] )) ) ] ] diff --git a/tests/Test/Tools/Json.elm b/tests/Test/Tools/Json.elm new file mode 100644 index 0000000..6124615 --- /dev/null +++ b/tests/Test/Tools/Json.elm @@ -0,0 +1,508 @@ +module Test.Tools.Json exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Tools.Json as Json +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) + + +type alias Human2 = + { name : String, age : Maybe Int } + + +type alias Human3 = + { name : String, age : Maybe Int, hobbies : List String } + + +type alias Human4 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + } + + +type alias Human5 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + , height : Float + } + + +type alias Human6 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + , height : Float + , invitedToParty : Bool + } + + +type alias Human7 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + , height : Float + , invitedToParty : Bool + , presentGiven : Maybe String + } + + +type alias Human8 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + , height : Float + , invitedToParty : Bool + , presentGiven : Maybe String + , grid : List (List Int) + } + + +type alias MegaHuman = + { human2 : Human2 + , human3 : Human3 + , human4 : Human4 + , human5 : Human5 + , human6 : Human6 + , human7 : Human7 + , human8 : Human8 + } + + +ageField : Json.Field (Maybe Int) { a | age : Maybe Int } +ageField = + Json.field.optional.value + { fieldName = "age" + , toField = .age + , description = [] + , coder = Json.int + } + + +ageFuzzer : Fuzzer (Maybe Int) +ageFuzzer = + Fuzz.maybe Fuzz.int + + +gridField : Json.Field (List (List Int)) { a | grid : List (List Int) } +gridField = + Json.field.optional.withDefault + { fieldName = "grid" + , toField = .grid + , description = [] + , coder = Json.list (Json.list Json.int) + , default = ( [], [] ) + , defaultToString = always "[]" + } + + +gridFuzzer : Fuzzer (List (List Int)) +gridFuzzer = + Fuzz.list (Fuzz.list Fuzz.int) + + +heightField : Json.Field Float { a | height : Float } +heightField = + Json.field.required + { fieldName = "height" + , toField = .height + , description = [] + , coder = Json.float + } + + +heightFuzzer : Fuzzer Float +heightFuzzer = + Fuzz.niceFloat + + +hobbiesField : Json.Field (List String) { a | hobbies : List String } +hobbiesField = + Json.field.optional.withDefault + { fieldName = "hobbies" + , toField = .hobbies + , description = [] + , coder = Json.list Json.string + , default = ( [], [] ) + , defaultToString = always "[]" + } + + +hobbiesFuzzer : Fuzzer (List String) +hobbiesFuzzer = + Fuzz.list Fuzz.string + + +invitedToPartyField : Json.Field Bool { a | invitedToParty : Bool } +invitedToPartyField = + Json.field.optional.withDefault + { fieldName = "invitedToParty" + , toField = .invitedToParty + , description = [] + , coder = Json.bool + , default = ( False, [] ) + , defaultToString = + \b -> + if b then + "True" + + else + "False" + } + + +invitedToPartyFuzzer : Fuzzer Bool +invitedToPartyFuzzer = + Fuzz.bool + + +nameField : Json.Field String { a | name : String } +nameField = + Json.field.required + { fieldName = "name" + , toField = .name + , description = [] + , coder = Json.string + } + + +nameFuzzer : Fuzzer String +nameFuzzer = + Fuzz.string + + +presentGivenField : Json.Field (Maybe String) { a | presentGiven : Maybe String } +presentGivenField = + Json.field.required + { fieldName = "presentGiven" + , toField = .presentGiven + , description = [] + , coder = Json.maybe Json.string + } + + +presentGivenFuzzer : Fuzzer (Maybe String) +presentGivenFuzzer = + Fuzz.maybe Fuzz.string + + +weightField : Json.Field (Maybe Float) { a | weight : Maybe Float } +weightField = + Json.field.optional.value + { fieldName = "weight" + , toField = .weight + , description = [] + , coder = Json.float + } + + +weightFuzzer : Fuzzer (Maybe Float) +weightFuzzer = + -- TODO: Maybe make Float not so nice? + Fuzz.maybe Fuzz.niceFloat + + +human2Coder : Json.Coder Human2 +human2Coder = + Json.object2 + { name = "Human2" + , description = [] + , init = Human2 + } + nameField + ageField + + +human2Fuzzer : Fuzzer Human2 +human2Fuzzer = + Fuzz.map2 Human2 + nameFuzzer + ageFuzzer + + +human3Coder : Json.Coder Human3 +human3Coder = + Json.object3 + { name = "Human3" + , description = [] + , init = Human3 + } + nameField + ageField + hobbiesField + + +human3Fuzzer : Fuzzer Human3 +human3Fuzzer = + Fuzz.map3 Human3 + nameFuzzer + ageFuzzer + hobbiesFuzzer + + +human4Coder : Json.Coder Human4 +human4Coder = + Json.object4 + { name = "Human4" + , description = [] + , init = Human4 + } + nameField + ageField + hobbiesField + weightField + + +human4Fuzzer : Fuzzer Human4 +human4Fuzzer = + Fuzz.map4 Human4 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + + +human5Coder : Json.Coder Human5 +human5Coder = + Json.object5 + { name = "Human5" + , description = [] + , init = Human5 + } + nameField + ageField + hobbiesField + weightField + heightField + + +human5Fuzzer : Fuzzer Human5 +human5Fuzzer = + Fuzz.map5 Human5 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + heightFuzzer + + +human6Coder : Json.Coder Human6 +human6Coder = + Json.object6 + { name = "Human6" + , description = [] + , init = Human6 + } + nameField + ageField + hobbiesField + weightField + heightField + invitedToPartyField + + +human6Fuzzer : Fuzzer Human6 +human6Fuzzer = + Fuzz.map6 Human6 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + heightFuzzer + invitedToPartyFuzzer + + +human7Coder : Json.Coder Human7 +human7Coder = + Json.object7 + { name = "Human7" + , description = [] + , init = Human7 + } + nameField + ageField + hobbiesField + weightField + heightField + invitedToPartyField + presentGivenField + + +human7Fuzzer : Fuzzer Human7 +human7Fuzzer = + Fuzz.map7 Human7 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + heightFuzzer + invitedToPartyFuzzer + presentGivenFuzzer + + +human8Coder : Json.Coder Human8 +human8Coder = + Json.object8 + { name = "Human8" + , description = [] + , init = Human8 + } + nameField + ageField + hobbiesField + weightField + heightField + invitedToPartyField + presentGivenField + gridField + + +human8Fuzzer : Fuzzer Human8 +human8Fuzzer = + Fuzz.map8 Human8 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + heightFuzzer + invitedToPartyFuzzer + presentGivenFuzzer + gridFuzzer + + +megaHumanCoder : Json.Coder MegaHuman +megaHumanCoder = + Json.object7 + { name = "MegaHuman" + , description = [] + , init = MegaHuman + } + (Json.field.required { fieldName = "h2", toField = .human2, description = [], coder = human2Coder }) + (Json.field.required { fieldName = "h3", toField = .human3, description = [], coder = human3Coder }) + (Json.field.required { fieldName = "h4", toField = .human4, description = [], coder = human4Coder }) + (Json.field.required { fieldName = "h5", toField = .human5, description = [], coder = human5Coder }) + (Json.field.required { fieldName = "h6", toField = .human6, description = [], coder = human6Coder }) + (Json.field.required { fieldName = "h7", toField = .human7, description = [], coder = human7Coder }) + (Json.field.required { fieldName = "h8", toField = .human8, description = [], coder = human8Coder }) + + +megahumanFuzzer : Fuzzer MegaHuman +megahumanFuzzer = + Fuzz.map7 MegaHuman + human2Fuzzer + human3Fuzzer + human4Fuzzer + human5Fuzzer + human6Fuzzer + human7Fuzzer + human8Fuzzer + + +suite : Test +suite = + describe "JSON module" + [ describe "Human2" + [ fuzz human2Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human2Coder + |> E.encode 0 + |> D.decodeString (Json.decode human2Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human3" + [ fuzz human3Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human3Coder + |> E.encode 0 + |> D.decodeString (Json.decode human3Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human4" + [ fuzz human4Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human4Coder + |> E.encode 0 + |> D.decodeString (Json.decode human4Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human5" + [ fuzz human5Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human5Coder + |> E.encode 0 + |> D.decodeString (Json.decode human5Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human6" + [ fuzz human6Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human6Coder + |> E.encode 0 + |> D.decodeString (Json.decode human6Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human7" + [ fuzz human7Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human7Coder + |> E.encode 0 + |> D.decodeString (Json.decode human7Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human8" + [ fuzz human8Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human8Coder + |> E.encode 0 + |> D.decodeString (Json.decode human8Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "MegaHuman" + [ fuzz megahumanFuzzer + "Recoding succeeds" + (\megahuman -> + megahuman + |> Json.encode megaHumanCoder + |> E.encode 0 + |> D.decodeString (Json.decode megaHumanCoder) + |> Result.map Tuple.first + |> Expect.equal (Ok megahuman) + ) + ] + ] diff --git a/tests/Test/Tools/Mashdict.elm b/tests/Test/Tools/Mashdict.elm index dfddc6c..0425dc0 100644 --- a/tests/Test/Tools/Mashdict.elm +++ b/tests/Test/Tools/Mashdict.elm @@ -2,6 +2,7 @@ module Test.Tools.Mashdict exposing (..) import Expect import Fuzz exposing (Fuzzer) +import Internal.Tools.Json as Json import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) import Internal.Values.Event as Event import Json.Decode as D @@ -93,11 +94,11 @@ suite = "JSON encode -> JSON decode" (\indent -> Mashdict.empty Just - |> Mashdict.encode E.string + |> Json.encode (Mashdict.coder Just Json.string) |> E.encode indent - |> D.decodeString (Mashdict.decoder Just D.string) - |> Result.map (Mashdict.isEqual (Mashdict.empty Just)) - |> Expect.equal (Ok True) + |> D.decodeString (Json.decode <| Mashdict.coder Just Json.string) + |> Result.map (Tuple.mapFirst <| Mashdict.isEqual (Mashdict.empty Just)) + |> Expect.equal (Ok ( True, [] )) ) ] , describe "singleton" @@ -194,11 +195,11 @@ suite = "JSON encode -> JSON decode" (\hashdict indent -> hashdict - |> Mashdict.encode Event.encode + |> Json.encode (Mashdict.coder .stateKey Event.coder) |> E.encode indent - |> D.decodeString (Mashdict.decoder .stateKey Event.decoder) - |> Result.map Mashdict.toList - |> Expect.equal (Ok <| Mashdict.toList hashdict) + |> D.decodeString (Json.decode <| Mashdict.coder .stateKey Event.coder) + |> Result.map (Tuple.mapFirst Mashdict.toList) + |> Expect.equal (Ok ( Mashdict.toList hashdict, [] )) ) ] ] diff --git a/tests/Test/Tools/Timestamp.elm b/tests/Test/Tools/Timestamp.elm index d98cafb..5721821 100644 --- a/tests/Test/Tools/Timestamp.elm +++ b/tests/Test/Tools/Timestamp.elm @@ -26,7 +26,7 @@ suite = |> Timestamp.encode |> E.encode indent |> D.decodeString Timestamp.decoder - |> Expect.equal (Ok time) + |> Expect.equal (Ok ( time, [] )) ) , fuzz fuzzer "JSON decode -> millis" @@ -42,7 +42,7 @@ suite = n |> E.int |> D.decodeValue Timestamp.decoder - |> Expect.equal (Ok <| Time.millisToPosix n) + |> Expect.equal (Ok ( Time.millisToPosix n, [] )) ) ] , describe "Identity" diff --git a/tests/Test/Values/Context.elm b/tests/Test/Values/Context.elm index 1b6dc55..c412daf 100644 --- a/tests/Test/Values/Context.elm +++ b/tests/Test/Values/Context.elm @@ -138,6 +138,6 @@ json = context |> Context.encode |> D.decodeValue Context.decoder - |> Expect.equal (Ok context) + |> Expect.equal (Ok ( context, [] )) ) ] diff --git a/tests/Test/Values/Envelope.elm b/tests/Test/Values/Envelope.elm index deb5036..e147b8d 100644 --- a/tests/Test/Values/Envelope.elm +++ b/tests/Test/Values/Envelope.elm @@ -3,6 +3,7 @@ module Test.Values.Envelope exposing (..) import Expect import Fuzz exposing (Fuzzer) import Internal.Config.Default as Default +import Internal.Tools.Json as Json import Internal.Values.Envelope as Envelope exposing (Envelope) import Json.Decode as D import Json.Encode as E @@ -56,10 +57,10 @@ suite = "JSON encode -> JSON decode" (\envelope indent -> envelope - |> Envelope.encode E.string + |> Envelope.encode Json.string |> E.encode indent - |> D.decodeString (Envelope.decoder D.string) - |> Expect.equal (Ok envelope) + |> D.decodeString (Envelope.decoder Json.string) + |> Expect.equal (Ok ( envelope, [] )) ) ] ] diff --git a/tests/Test/Values/Settings.elm b/tests/Test/Values/Settings.elm index 8edf86c..d48a851 100644 --- a/tests/Test/Values/Settings.elm +++ b/tests/Test/Values/Settings.elm @@ -61,7 +61,7 @@ suite = , test "JSON decode {} is init" ("{}" |> D.decodeString Settings.decoder - |> Expect.equal (Ok Settings.init) + |> Expect.equal (Ok ( Settings.init, [] )) |> always ) ] @@ -74,7 +74,7 @@ suite = |> Settings.encode |> E.encode indent |> D.decodeString Settings.decoder - |> Expect.equal (Ok settings) + |> Expect.equal (Ok ( settings, [] )) ) ] ] diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm index ec15032..7e0839e 100644 --- a/tests/Test/Values/StateManager.elm +++ b/tests/Test/Values/StateManager.elm @@ -84,7 +84,7 @@ suite = |> StateManager.encode |> E.encode 0 |> D.decodeString StateManager.decoder - |> Expect.equal (Ok StateManager.empty) + |> Expect.equal (Ok ( StateManager.empty, [] )) |> always ) ]