Compare commits

...

2 Commits

Author SHA1 Message Date
Bram acd13ac67a Complete documentation 2024-01-22 18:09:08 +01:00
Bram dd5f298fd3 Migrate remaining objects to new JSON coders 2024-01-22 17:44:22 +01:00
12 changed files with 266 additions and 106 deletions

View File

@ -112,14 +112,30 @@ decodedDictSize from to =
{-| Documentation used for all functions and data types in JSON coders {-| Documentation used for all functions and data types in JSON coders
-} -}
docs : docs :
{ event : TypeDocs { context : TypeDocs
, envelope : TypeDocs
, event : TypeDocs
, hashdict : TypeDocs , hashdict : TypeDocs
, mashdict : TypeDocs , mashdict : TypeDocs
, settings : TypeDocs
, stateManager : TypeDocs , stateManager : TypeDocs
, unsigned : TypeDocs , unsigned : TypeDocs
} }
docs = docs =
{ event = { 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" { name = "Event"
, description = , description =
[ "The Event type represents a single value that contains all the information for a single event in the room." [ "The Event type represents a single value that contains all the information for a single event in the room."
@ -138,6 +154,12 @@ docs =
[ "The mashdict exclusively stores values for which the hashing algorithm returns a value, and it ignores the outcome for all other scenarios." [ "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 = , stateManager =
{ name = "StateManager" { name = "StateManager"
, description = , description =
@ -168,12 +190,25 @@ failures =
} }
{-| Objects contain multiple fields. These fields are here described, explaining
-- TODO what they do and what they are for.
-}
fields : fields :
{ event : { 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 { content : Desc
, eventId : Desc , eventId : Desc
, originServerTs : Desc , originServerTs : Desc
@ -183,6 +218,11 @@ fields :
, eventType : Desc , eventType : Desc
, unsigned : Desc , unsigned : Desc
} }
, settings :
{ currentVersion : Desc
, deviceName : Desc
, syncTime : Desc
}
, unsigned : , unsigned :
{ age : Desc { age : Desc
, prevContent : Desc , prevContent : Desc
@ -191,7 +231,21 @@ fields :
} }
} }
fields = fields =
{ event = { context =
{ accessToken = []
, baseUrl = []
, password = []
, refreshToken = []
, username = []
, transaction = []
, versions = []
}
, envelope =
{ content = []
, context = []
, settings = []
}
, event =
{ content = [] { content = []
, eventId = [] , eventId = []
, originServerTs = [] , originServerTs = []
@ -201,6 +255,11 @@ fields =
, eventType = [] , eventType = []
, unsigned = [] , unsigned = []
} }
, settings =
{ currentVersion = []
, deviceName = []
, syncTime = []
}
, unsigned = , unsigned =
{ age = [] { age = []
, prevContent = [] , prevContent = []
@ -210,11 +269,17 @@ fields =
} }
{-| 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 : String
invalidHashInHashdict = invalidHashInHashdict =
"Invalid hash function: not all elements hash to their JSON-stored hashes" "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 : String
invalidHashInMashdict = invalidHashInMashdict =
"Invalid hash function: not all elements hash to their JSON-stored hashes" "Invalid hash function: not all elements hash to their JSON-stored hashes"

View File

@ -81,6 +81,8 @@ 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 : (a -> String) -> Json.Coder a -> Json.Coder (Hashdict a)
coder f c1 = coder f c1 =
Json.andThen Json.andThen

View File

@ -1,12 +1,11 @@
module Internal.Tools.Json exposing module Internal.Tools.Json exposing
( Coder, string, bool, int, float, value ( Coder, string, bool, int, float, value
, Encoder, encode, Decoder, decode, Value , Encoder, encode, Decoder, decode, Value
, succeed, fail, andThen, lazy , succeed, fail, andThen, lazy, map
, Docs(..), RequiredField(..), toDocs , Docs(..), RequiredField(..), toDocs
, list, slowDict, fastDict, maybe , list, slowDict, fastDict, maybe
, Field, field , Field, field
, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 , object2, object3, object4, object5, object6, object7, object8, object9, object10, object11
, map
) )
{-| {-|
@ -40,7 +39,7 @@ module to build its encoders and decoders.
## Optional coding ## Optional coding
@docs succeed, fail, andThen, lazy @docs succeed, fail, andThen, lazy, map
## Documentation ## Documentation
@ -69,7 +68,7 @@ Once all fields are constructed, the user can create JSON objects.
import Dict as SlowDict import Dict as SlowDict
import FastDict import FastDict
import Internal.Config.Log exposing (Log, log) import Internal.Config.Log exposing (Log)
import Internal.Tools.DecodeExtra as D import Internal.Tools.DecodeExtra as D
import Internal.Tools.EncodeExtra as E import Internal.Tools.EncodeExtra as E
import Json.Decode as D import Json.Decode as D
@ -176,6 +175,8 @@ type RequiredField
| OptionalFieldWithDefault String | OptionalFieldWithDefault String
{-| Represents an arbitary JavaScript value.
-}
type alias Value = type alias Value =
E.Value E.Value
@ -382,7 +383,14 @@ field =
{ fieldName = fieldName { fieldName = fieldName
, toField = toField , toField = toField
, description = description , description = description
, encoder = encoder >> Maybe.Just , 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 , decoder = D.opFieldWithDefault fieldName default decoder
, docs = docs , docs = docs
, requiredness = , requiredness =
@ -417,6 +425,8 @@ int =
} }
{-| Define a lazy coder. This is useful when defining recursive structures.
-}
lazy : (() -> Coder value) -> Coder value lazy : (() -> Coder value) -> Coder value
lazy f = lazy f =
Coder Coder
@ -1137,6 +1147,9 @@ toEncodeField (Field data) =
( data.fieldName, data.toField >> data.encoder ) ( 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 Value
value = value =
Coder Coder

View File

@ -93,6 +93,8 @@ 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 : (a -> Maybe String) -> Json.Coder a -> Json.Coder (Mashdict a)
coder f c1 = coder f c1 =
Json.andThen Json.andThen

View File

@ -1,5 +1,5 @@
module Internal.Values.Context exposing module Internal.Values.Context exposing
( Context, init, encode, decoder ( Context, init, coder, encode, decoder
, APIContext, apiFormat , APIContext, apiFormat
, setAccessToken, getAccessToken , setAccessToken, getAccessToken
, setBaseUrl, getBaseUrl , setBaseUrl, getBaseUrl
@ -14,7 +14,7 @@ the Matrix API.
## Context ## Context
@docs Context, init, encode, decoder @docs Context, init, coder, encode, decoder
## APIContext ## APIContext
@ -50,10 +50,8 @@ information that can be inserted.
-} -}
import Internal.Config.Leaks as L import Internal.Config.Leaks as L
import Internal.Tools.DecodeExtra as D import Internal.Config.Text as Text
import Internal.Tools.EncodeExtra as E import Internal.Tools.Json as Json
import Json.Decode as D
import Json.Encode as E
{-| The Context type stores all the information in the Vault. This data type is {-| 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. {-| Decode a Context type from a JSON value.
-} -}
decoder : D.Decoder Context decoder : Json.Decoder Context
decoder = decoder =
D.map7 Context Json.decode coder
(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))
{-| Encode a Context type into a JSON value. {-| Encode a Context type into a JSON value.
-} -}
encode : Context -> E.Value encode : Json.Encoder Context
encode context = encode =
E.maybeObject Json.encode coder
[ ( "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 )
]
{-| A basic, untouched version of the Context, containing no information. {-| A basic, untouched version of the Context, containing no information.

View File

@ -4,7 +4,7 @@ module Internal.Values.Envelope exposing
, Settings, mapSettings, extractSettings , Settings, mapSettings, extractSettings
, mapContext , mapContext
, getContent, extract , getContent, extract
, encode, decoder , coder, encode, decoder
) )
{-| The Envelope module wraps existing data types with lots of values and {-| The Envelope module wraps existing data types with lots of values and
@ -38,17 +38,14 @@ settings that can be adjusted manually.
## JSON coders ## JSON coders
@docs encode, decoder @docs coder, encode, decoder
-} -}
import Internal.Config.Default as Default import Internal.Config.Text as Text
import Internal.Tools.DecodeExtra as D import Internal.Tools.Json as Json
import Internal.Tools.EncodeExtra as E
import Internal.Values.Context as Context exposing (Context) import Internal.Values.Context as Context exposing (Context)
import Internal.Values.Settings as Settings 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 {-| There are lots of different data types in the Elm SDK, and many of them
@ -71,28 +68,54 @@ type alias Settings =
Settings.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 "<Default settings>"
}
)
{-| Decode an enveloped type from a JSON value. The decoder also imports any {-| Decode an enveloped type from a JSON value. The decoder also imports any
potential tokens, values and settings included in the JSON. potential tokens, values and settings included in the JSON.
-} -}
decoder : D.Decoder a -> D.Decoder (Envelope a) decoder : Json.Coder a -> Json.Decoder (Envelope a)
decoder xDecoder = decoder c1 =
D.map3 Envelope Json.decode (coder c1)
(D.field "content" xDecoder)
(D.field "context" Context.decoder)
(D.field "settings" Settings.decoder)
{-| Encode an enveloped type into a JSON value. The function encodes all {-| Encode an enveloped type into a JSON value. The function encodes all
non-standard settings, tokens and values. non-standard settings, tokens and values.
-} -}
encode : (a -> E.Value) -> Envelope a -> E.Value encode : Json.Coder a -> Json.Encoder (Envelope a)
encode encodeX data = encode c1 =
E.object Json.encode (coder c1)
[ ( "content", encodeX data.content )
, ( "context", Context.encode data.context )
, ( "settings", Settings.encode data.settings )
, ( "version", E.string Default.currentVersion )
]
{-| Map a function, then get its content. This is useful for getting information {-| Map a function, then get its content. This is useful for getting information

View File

@ -26,7 +26,6 @@ of a room.
-} -}
import Internal.Config.Default as Default
import Internal.Config.Text as Text import Internal.Config.Text as Text
import Internal.Tools.Json as Json import Internal.Tools.Json as Json
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
@ -65,6 +64,8 @@ age event =
Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned 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.Coder Event
coder = coder =
Json.object8 Json.object8

View File

@ -1,6 +1,6 @@
module Internal.Values.Settings exposing module Internal.Values.Settings exposing
( Settings, init ( Settings, init
, encode, decoder , coder, encode, decoder
) )
{-| {-|
@ -16,15 +16,13 @@ data types.
## JSON coders ## JSON coders
@docs encode, decoder @docs coder, encode, decoder
-} -}
import Internal.Config.Default as Default import Internal.Config.Default as Default
import Internal.Tools.DecodeExtra as D import Internal.Config.Text as Text
import Internal.Tools.EncodeExtra as E import Internal.Tools.Json as Json
import Json.Decode as D
import Json.Encode as E
{-| Custom settings that can be manipulated by the user. These serve as a {-| 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. {-| Decode settings from a JSON value.
-} -}
decoder : D.Decoder Settings decoder : Json.Decoder Settings
decoder = decoder =
D.map3 Settings Json.decode coder
(D.opFieldWithDefault "currentVersion" Default.currentVersion D.string)
(D.opFieldWithDefault "deviceName" Default.deviceName D.string)
(D.opFieldWithDefault "syncTime" Default.syncTime D.int)
{-| Encode the settings into a JSON value. {-| Encode the settings into a JSON value.
-} -}
encode : Settings -> E.Value encode : Json.Encoder Settings
encode settings = encode =
let Json.encode coder
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
)
]
{-| Create a new Settings module based on default values {-| Create a new Settings module based on default values

View File

@ -93,6 +93,8 @@ cleanKey key (StateManager manager) =
|> StateManager |> StateManager
{-| Define how a StateManager can be encoded to and decoded from a JSON object.
-}
coder : Json.Coder StateManager coder : Json.Coder StateManager
coder = coder =
Event.coder Event.coder

View File

@ -138,6 +138,6 @@ json =
context context
|> Context.encode |> Context.encode
|> D.decodeValue Context.decoder |> D.decodeValue Context.decoder
|> Expect.equal (Ok context) |> Expect.equal (Ok ( context, [] ))
) )
] ]

View File

@ -3,6 +3,7 @@ module Test.Values.Envelope exposing (..)
import Expect import Expect
import Fuzz exposing (Fuzzer) import Fuzz exposing (Fuzzer)
import Internal.Config.Default as Default import Internal.Config.Default as Default
import Internal.Tools.Json as Json
import Internal.Values.Envelope as Envelope exposing (Envelope) import Internal.Values.Envelope as Envelope exposing (Envelope)
import Json.Decode as D import Json.Decode as D
import Json.Encode as E import Json.Encode as E
@ -56,10 +57,10 @@ suite =
"JSON encode -> JSON decode" "JSON encode -> JSON decode"
(\envelope indent -> (\envelope indent ->
envelope envelope
|> Envelope.encode E.string |> Envelope.encode Json.string
|> E.encode indent |> E.encode indent
|> D.decodeString (Envelope.decoder D.string) |> D.decodeString (Envelope.decoder Json.string)
|> Expect.equal (Ok envelope) |> Expect.equal (Ok ( envelope, [] ))
) )
] ]
] ]

View File

@ -61,7 +61,7 @@ suite =
, test "JSON decode {} is init" , test "JSON decode {} is init"
("{}" ("{}"
|> D.decodeString Settings.decoder |> D.decodeString Settings.decoder
|> Expect.equal (Ok Settings.init) |> Expect.equal (Ok ( Settings.init, [] ))
|> always |> always
) )
] ]
@ -74,7 +74,7 @@ suite =
|> Settings.encode |> Settings.encode
|> E.encode indent |> E.encode indent
|> D.decodeString Settings.decoder |> D.decodeString Settings.decoder
|> Expect.equal (Ok settings) |> Expect.equal (Ok ( settings, [] ))
) )
] ]
] ]