commit
70f57b1b96
20
elm.json
20
elm.json
|
@ -6,7 +6,25 @@
|
||||||
"version": "2.0.0",
|
"version": "2.0.0",
|
||||||
"exposed-modules": [
|
"exposed-modules": [
|
||||||
"Matrix",
|
"Matrix",
|
||||||
"Matrix.Settings"
|
"Matrix.Event",
|
||||||
|
"Matrix.Settings",
|
||||||
|
"Internal.Config.Default",
|
||||||
|
"Internal.Config.Leaks",
|
||||||
|
"Internal.Config.Text",
|
||||||
|
"Internal.Tools.Decode",
|
||||||
|
"Internal.Tools.Encode",
|
||||||
|
"Internal.Tools.Hashdict",
|
||||||
|
"Internal.Tools.Iddict",
|
||||||
|
"Internal.Tools.Mashdict",
|
||||||
|
"Internal.Tools.Timestamp",
|
||||||
|
"Internal.Tools.VersionControl",
|
||||||
|
"Internal.Values.Context",
|
||||||
|
"Internal.Values.Envelope",
|
||||||
|
"Internal.Values.Event",
|
||||||
|
"Internal.Values.Settings",
|
||||||
|
"Internal.Values.StateManager",
|
||||||
|
"Internal.Values.Vault",
|
||||||
|
"Types"
|
||||||
],
|
],
|
||||||
"elm-version": "0.19.0 <= v < 0.20.0",
|
"elm-version": "0.19.0 <= v < 0.20.0",
|
||||||
"dependencies": {
|
"dependencies": {
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
module Internal.Tools.Hashdict exposing
|
module Internal.Tools.Hashdict exposing
|
||||||
( Hashdict
|
( Hashdict
|
||||||
, empty, singleton, insert, remove, removeKey
|
, empty, singleton, insert, remove, removeKey
|
||||||
, isEmpty, member, memberKey, get, size
|
, isEmpty, member, memberKey, get, size, isEqual
|
||||||
, keys, values, toList, fromList
|
, keys, values, toList, fromList
|
||||||
, rehash, union
|
, rehash, union
|
||||||
, encode, decoder, softDecoder
|
, encode, decoder, softDecoder
|
||||||
|
@ -25,7 +25,7 @@ This allows you to store values based on an externally defined identifier.
|
||||||
|
|
||||||
## Query
|
## Query
|
||||||
|
|
||||||
@docs isEmpty, member, memberKey, get, size
|
@docs isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
|
||||||
|
|
||||||
## Lists
|
## Lists
|
||||||
|
@ -151,6 +151,14 @@ insert v (Hashdict h) =
|
||||||
Hashdict { h | values = Dict.insert (h.hash v) v h.values }
|
Hashdict { h | values = Dict.insert (h.hash v) v h.values }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Since the Hashdict contains a hash function, the == operator does not work
|
||||||
|
simply. Instead, you should use the isEqual operator.
|
||||||
|
-}
|
||||||
|
isEqual : Hashdict a -> Hashdict a -> Bool
|
||||||
|
isEqual h1 h2 =
|
||||||
|
toList h1 == toList h2
|
||||||
|
|
||||||
|
|
||||||
{-| Determine if a hashdict is empty.
|
{-| Determine if a hashdict is empty.
|
||||||
-}
|
-}
|
||||||
isEmpty : Hashdict a -> Bool
|
isEmpty : Hashdict a -> Bool
|
||||||
|
|
|
@ -0,0 +1,300 @@
|
||||||
|
module Internal.Tools.Mashdict exposing
|
||||||
|
( Mashdict
|
||||||
|
, empty, singleton, insert, remove, removeKey
|
||||||
|
, isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
, keys, values, toList, fromList
|
||||||
|
, rehash, union
|
||||||
|
, encode, decoder, softDecoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Mashdict
|
||||||
|
|
||||||
|
A **mashdict**, (short for "maybe mashdict") is a hashdict that uses a hash
|
||||||
|
function that _maybe_ returns a value. In this case, the mashdict exclusively
|
||||||
|
stores values for which the hashing algorithm returns a value, and it ignores
|
||||||
|
the outcome for all other scenarios.
|
||||||
|
|
||||||
|
In general, you are advised to learn more about the
|
||||||
|
[Hashdict](Internal-Tools-Hashdict) before delving into the Mashdict.
|
||||||
|
|
||||||
|
|
||||||
|
## Dictionaries
|
||||||
|
|
||||||
|
@docs Mashdict
|
||||||
|
|
||||||
|
|
||||||
|
## Build
|
||||||
|
|
||||||
|
@docs empty, singleton, insert, remove, removeKey
|
||||||
|
|
||||||
|
|
||||||
|
## Query
|
||||||
|
|
||||||
|
@docs isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
|
||||||
|
|
||||||
|
## Lists
|
||||||
|
|
||||||
|
@docs keys, values, toList, fromList
|
||||||
|
|
||||||
|
|
||||||
|
## Transform
|
||||||
|
|
||||||
|
@docs rehash, union
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs encode, decoder, softDecoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| A dictionary of keys and values where each key is defined by its value, but
|
||||||
|
a value is not always given. For example, this can be relevant when not all
|
||||||
|
inserted values are relevant:
|
||||||
|
|
||||||
|
import Mashdict exposing (Mashdict)
|
||||||
|
|
||||||
|
users : Mashdict Event
|
||||||
|
users =
|
||||||
|
Mashdict.fromList .location
|
||||||
|
[ Event "Graduation party" 8 (Just "park")
|
||||||
|
, Event "National holiday" 17 Nothing
|
||||||
|
, Event "Local fair" 11 (Just "town square")
|
||||||
|
]
|
||||||
|
|
||||||
|
-- National holiday will be ignored
|
||||||
|
-- because it does not hash
|
||||||
|
type alias Event =
|
||||||
|
{ name : String
|
||||||
|
, participants : Int
|
||||||
|
, location : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
In the example listed above, all events are stored by their specified location,
|
||||||
|
which means that all you need to know is the value "park" to retrieve all the
|
||||||
|
information about the event at the park. As a result of optimization, this means
|
||||||
|
all values without a hash, are filtered out, as we can never query them.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Mashdict a
|
||||||
|
= Mashdict
|
||||||
|
{ hash : a -> Maybe String
|
||||||
|
, values : Dict String a
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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"
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create an empty mashdict.
|
||||||
|
-}
|
||||||
|
empty : (a -> Maybe String) -> Mashdict a
|
||||||
|
empty hash =
|
||||||
|
Mashdict { hash = hash, values = Dict.empty }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode a Mashdict into a JSON value. Keep in mind that an Elm function
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert an association list into a mashdict.
|
||||||
|
-}
|
||||||
|
fromList : (a -> Maybe String) -> List a -> Mashdict a
|
||||||
|
fromList hash xs =
|
||||||
|
Mashdict
|
||||||
|
{ hash = hash
|
||||||
|
, values =
|
||||||
|
xs
|
||||||
|
|> List.filterMap (\x -> hash x |> Maybe.map (\hx -> ( hx, x )))
|
||||||
|
|> Dict.fromList
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the value associated with a hash. If the hash is not found, return
|
||||||
|
`Nothing`. This is useful when you are not sure if a hash will be in the
|
||||||
|
mashdict.
|
||||||
|
-}
|
||||||
|
get : String -> Mashdict a -> Maybe a
|
||||||
|
get k (Mashdict h) =
|
||||||
|
Dict.get k h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a value into a mashdict. The key is automatically generated by the
|
||||||
|
hash function. If the function generates a collision, it replaces the existing
|
||||||
|
value in the mashdict. If the function returns `Nothing`, the value isn't
|
||||||
|
inserted and the original Mashdict is returned.
|
||||||
|
-}
|
||||||
|
insert : a -> Mashdict a -> Mashdict a
|
||||||
|
insert v (Mashdict h) =
|
||||||
|
case h.hash v of
|
||||||
|
Just hash ->
|
||||||
|
Mashdict { h | values = Dict.insert hash v h.values }
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Mashdict h
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a mashdict is empty.
|
||||||
|
-}
|
||||||
|
isEmpty : Mashdict a -> Bool
|
||||||
|
isEmpty (Mashdict h) =
|
||||||
|
Dict.isEmpty h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Since the Hashdict contains a hash function, the == operator does not work
|
||||||
|
simply. Instead, you should use the isEqual operator.
|
||||||
|
-}
|
||||||
|
isEqual : Mashdict a -> Mashdict a -> Bool
|
||||||
|
isEqual h1 h2 =
|
||||||
|
toList h1 == toList h2
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get all of the hashes in a mashdict, sorted from lowest to highest.
|
||||||
|
-}
|
||||||
|
keys : Mashdict a -> List String
|
||||||
|
keys (Mashdict h) =
|
||||||
|
Dict.keys h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a value's hash is in a mashdict.
|
||||||
|
-}
|
||||||
|
member : a -> Mashdict a -> Bool
|
||||||
|
member value (Mashdict h) =
|
||||||
|
h.hash value
|
||||||
|
|> Maybe.map (\key -> Dict.member key h.values)
|
||||||
|
|> Maybe.withDefault False
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a hash is in a mashdict.
|
||||||
|
-}
|
||||||
|
memberKey : String -> Mashdict a -> Bool
|
||||||
|
memberKey key (Mashdict h) =
|
||||||
|
Dict.member key h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remap a mashdict using a new hashing algorithm.
|
||||||
|
-}
|
||||||
|
rehash : (a -> Maybe String) -> Mashdict a -> Mashdict a
|
||||||
|
rehash f (Mashdict h) =
|
||||||
|
Mashdict
|
||||||
|
{ hash = f
|
||||||
|
, values =
|
||||||
|
h.values
|
||||||
|
|> Dict.values
|
||||||
|
|> List.filterMap
|
||||||
|
(\v -> Maybe.map (\hash -> ( hash, v )) (f v))
|
||||||
|
|> Dict.fromList
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remove a value from a mashdict. If the value's hash is found, the key-value
|
||||||
|
pair is removed. If the value's hash is not found, no changes are made.
|
||||||
|
|
||||||
|
hdict |> Mashdict.remove (Event "Graduation party" 8 (Just "park"))
|
||||||
|
|
||||||
|
-}
|
||||||
|
remove : a -> Mashdict a -> Mashdict a
|
||||||
|
remove v (Mashdict h) =
|
||||||
|
case h.hash v of
|
||||||
|
Just hash ->
|
||||||
|
Mashdict { h | values = Dict.remove hash h.values }
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Mashdict h
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remove a key from a mashdict. If the key is not found, no changes are made.
|
||||||
|
|
||||||
|
hdict |> Mashdict.removeKey "park"
|
||||||
|
|
||||||
|
-}
|
||||||
|
removeKey : String -> Mashdict a -> Mashdict a
|
||||||
|
removeKey k (Mashdict h) =
|
||||||
|
Mashdict { h | values = Dict.remove k h.values }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a mashdict with a single key-value pair.
|
||||||
|
-}
|
||||||
|
singleton : (a -> Maybe String) -> a -> Mashdict a
|
||||||
|
singleton f v =
|
||||||
|
empty f |> insert v
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the number of values in a mashdict.
|
||||||
|
-}
|
||||||
|
size : Mashdict a -> Int
|
||||||
|
size (Mashdict h) =
|
||||||
|
Dict.size h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a mashdict from a JSON value. If you cannot deduce the originally
|
||||||
|
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)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert a mashdict into an association list of key-value pairs, sorted by
|
||||||
|
keys.
|
||||||
|
-}
|
||||||
|
toList : Mashdict a -> List ( String, a )
|
||||||
|
toList (Mashdict h) =
|
||||||
|
Dict.toList h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Combine two mashdicts under the hash function of the first. If there is a
|
||||||
|
collision, preference is given to the first mashdict.
|
||||||
|
-}
|
||||||
|
union : Mashdict a -> Mashdict a -> Mashdict a
|
||||||
|
union (Mashdict h1) hd2 =
|
||||||
|
case rehash h1.hash hd2 of
|
||||||
|
Mashdict h2 ->
|
||||||
|
Mashdict
|
||||||
|
{ hash = h1.hash
|
||||||
|
, values = Dict.union h1.values h2.values
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get all values stored in the mashdict, in the order of their keys.
|
||||||
|
-}
|
||||||
|
values : Mashdict a -> List a
|
||||||
|
values (Mashdict h) =
|
||||||
|
Dict.values h.values
|
|
@ -46,6 +46,7 @@ import Internal.Config.Default as Default
|
||||||
import Internal.Tools.Decode as D
|
import Internal.Tools.Decode as D
|
||||||
import Internal.Tools.Encode as E
|
import Internal.Tools.Encode 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 Json.Decode as D
|
import Json.Decode as D
|
||||||
import Json.Encode as E
|
import Json.Encode as E
|
||||||
|
|
||||||
|
@ -55,26 +56,19 @@ need the same values. The Envelope type wraps settings, tokens and values around
|
||||||
each data type so they can all enjoy those values without needing to explicitly
|
each data type so they can all enjoy those values without needing to explicitly
|
||||||
define them in their type.
|
define them in their type.
|
||||||
-}
|
-}
|
||||||
type Envelope a
|
type alias Envelope a =
|
||||||
= Envelope
|
|
||||||
{ content : a
|
{ content : a
|
||||||
, context : Context
|
, context : Context
|
||||||
, settings : Settings
|
, settings : Settings
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Custom settings that can be manipulated by the user. These serve as a
|
{-| Settings value from
|
||||||
configuration for how the Elm SDK should behave.
|
[Internal.Values.Settings](Internal-Values-Settings#Settings). Can be used to
|
||||||
|
manipulate the Matrix Vault.
|
||||||
Custom settings are always part of the Envelope, allowing all functions to
|
|
||||||
behave under the user's preferred settings.
|
|
||||||
|
|
||||||
-}
|
-}
|
||||||
type alias Settings =
|
type alias Settings =
|
||||||
{ currentVersion : String
|
Settings.Settings
|
||||||
, deviceName : String
|
|
||||||
, syncTime : Int
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
{-| 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
|
||||||
|
@ -82,67 +76,25 @@ potential tokens, values and settings included in the JSON.
|
||||||
-}
|
-}
|
||||||
decoder : D.Decoder a -> D.Decoder (Envelope a)
|
decoder : D.Decoder a -> D.Decoder (Envelope a)
|
||||||
decoder xDecoder =
|
decoder xDecoder =
|
||||||
D.map3 (\a b c -> Envelope { content = a, context = b, settings = c })
|
D.map3 Envelope
|
||||||
(D.field "content" xDecoder)
|
(D.field "content" xDecoder)
|
||||||
(D.field "context" Context.decoder)
|
(D.field "context" Context.decoder)
|
||||||
(D.field "settings" decoderSettings)
|
(D.field "settings" Settings.decoder)
|
||||||
|
|
||||||
|
|
||||||
{-| Decode settings from a JSON value.
|
|
||||||
-}
|
|
||||||
decoderSettings : D.Decoder Settings
|
|
||||||
decoderSettings =
|
|
||||||
D.map3 Settings
|
|
||||||
(D.opFieldWithDefault "currentVersion" Default.currentVersion D.string)
|
|
||||||
(D.opFieldWithDefault "deviceName" Default.deviceName D.string)
|
|
||||||
(D.opFieldWithDefault "syncTime" Default.syncTime D.int)
|
|
||||||
|
|
||||||
|
|
||||||
{-| 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 : (a -> E.Value) -> Envelope a -> E.Value
|
||||||
encode encodeX (Envelope data) =
|
encode encodeX data =
|
||||||
E.object
|
E.object
|
||||||
[ ( "content", encodeX data.content )
|
[ ( "content", encodeX data.content )
|
||||||
, ( "context", Context.encode data.context )
|
, ( "context", Context.encode data.context )
|
||||||
, ( "settings", encodeSettings data.settings )
|
, ( "settings", Settings.encode data.settings )
|
||||||
, ( "version", E.string Default.currentVersion )
|
, ( "version", E.string Default.currentVersion )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
{-| Encode the settings into a JSON value.
|
|
||||||
-}
|
|
||||||
encodeSettings : Settings -> E.Value
|
|
||||||
encodeSettings 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
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
{-| 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
|
||||||
from a data type inside an Envelope.
|
from a data type inside an Envelope.
|
||||||
|
|
||||||
|
@ -155,7 +107,7 @@ from a data type inside an Envelope.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
extract : (a -> b) -> Envelope a -> b
|
extract : (a -> b) -> Envelope a -> b
|
||||||
extract f (Envelope data) =
|
extract f data =
|
||||||
f data.content
|
f data.content
|
||||||
|
|
||||||
|
|
||||||
|
@ -165,7 +117,7 @@ This can be helpful if you have a UI that displays custom settings to a user.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
extractSettings : (Settings -> b) -> Envelope a -> b
|
extractSettings : (Settings -> b) -> Envelope a -> b
|
||||||
extractSettings f (Envelope data) =
|
extractSettings f data =
|
||||||
f data.settings
|
f data.settings
|
||||||
|
|
||||||
|
|
||||||
|
@ -186,14 +138,9 @@ from the [Internal.Config.Default](Internal-Config-Default) module.
|
||||||
-}
|
-}
|
||||||
init : a -> Envelope a
|
init : a -> Envelope a
|
||||||
init x =
|
init x =
|
||||||
Envelope
|
|
||||||
{ content = x
|
{ content = x
|
||||||
, context = Context.init
|
, context = Context.init
|
||||||
, settings =
|
, settings = Settings.init
|
||||||
{ currentVersion = Default.currentVersion
|
|
||||||
, deviceName = Default.deviceName
|
|
||||||
, syncTime = Default.syncTime
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -208,8 +155,7 @@ init x =
|
||||||
|
|
||||||
-}
|
-}
|
||||||
map : (a -> b) -> Envelope a -> Envelope b
|
map : (a -> b) -> Envelope a -> Envelope b
|
||||||
map f (Envelope data) =
|
map f data =
|
||||||
Envelope
|
|
||||||
{ content = f data.content
|
{ content = f data.content
|
||||||
, context = data.context
|
, context = data.context
|
||||||
, settings = data.settings
|
, settings = data.settings
|
||||||
|
@ -219,12 +165,8 @@ map f (Envelope data) =
|
||||||
{-| Update the Context in the Envelope.
|
{-| Update the Context in the Envelope.
|
||||||
-}
|
-}
|
||||||
mapContext : (Context -> Context) -> Envelope a -> Envelope a
|
mapContext : (Context -> Context) -> Envelope a -> Envelope a
|
||||||
mapContext f (Envelope data) =
|
mapContext f data =
|
||||||
Envelope
|
{ data | context = f data.context }
|
||||||
{ content = data.content
|
|
||||||
, context = f data.context
|
|
||||||
, settings = data.settings
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
{-| Map the contents of a function, where the result is wrapped in a `List`
|
{-| Map the contents of a function, where the result is wrapped in a `List`
|
||||||
|
@ -279,23 +221,19 @@ mapMaybe f =
|
||||||
|
|
||||||
-}
|
-}
|
||||||
mapSettings : (Settings -> Settings) -> Envelope a -> Envelope a
|
mapSettings : (Settings -> Settings) -> Envelope a -> Envelope a
|
||||||
mapSettings f (Envelope data) =
|
mapSettings f data =
|
||||||
Envelope
|
{ data | settings = f data.settings }
|
||||||
{ content = data.content
|
|
||||||
, context = data.context
|
|
||||||
, settings = f data.settings
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
toList : Envelope (List a) -> List (Envelope a)
|
toList : Envelope (List a) -> List (Envelope a)
|
||||||
toList (Envelope data) =
|
toList data =
|
||||||
List.map
|
List.map
|
||||||
(\content -> map (always content) (Envelope data))
|
(\content -> map (always content) data)
|
||||||
data.content
|
data.content
|
||||||
|
|
||||||
|
|
||||||
toMaybe : Envelope (Maybe a) -> Maybe (Envelope a)
|
toMaybe : Envelope (Maybe a) -> Maybe (Envelope a)
|
||||||
toMaybe (Envelope data) =
|
toMaybe data =
|
||||||
Maybe.map
|
Maybe.map
|
||||||
(\content -> map (always content) (Envelope data))
|
(\content -> map (always content) data)
|
||||||
data.content
|
data.content
|
||||||
|
|
|
@ -0,0 +1,147 @@
|
||||||
|
module Internal.Values.Event exposing
|
||||||
|
( Event
|
||||||
|
, UnsignedData(..), age, prevContent, redactedBecause, transactionId
|
||||||
|
, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Event
|
||||||
|
|
||||||
|
The `Event` module hosts all the information for a single event in the timeline
|
||||||
|
of a room.
|
||||||
|
|
||||||
|
@docs Event
|
||||||
|
|
||||||
|
|
||||||
|
## Unsigned data
|
||||||
|
|
||||||
|
@docs UnsignedData, age, prevContent, redactedBecause, transactionId
|
||||||
|
|
||||||
|
|
||||||
|
## JSON Coder
|
||||||
|
|
||||||
|
@docs encode, decoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Default as Default
|
||||||
|
import Internal.Tools.Decode as D
|
||||||
|
import Internal.Tools.Encode as E
|
||||||
|
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
|
||||||
|
, eventId : String
|
||||||
|
, originServerTs : Timestamp
|
||||||
|
, roomId : String
|
||||||
|
, sender : String
|
||||||
|
, stateKey : Maybe String
|
||||||
|
, eventType : String
|
||||||
|
, unsigned : Maybe UnsignedData
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Unsigned Data contains a lot of extra information. You can access it through
|
||||||
|
helper functions.
|
||||||
|
-}
|
||||||
|
type UnsignedData
|
||||||
|
= UnsignedData
|
||||||
|
{ age : Maybe Int
|
||||||
|
, prevContent : Maybe E.Value
|
||||||
|
, redactedBecause : Maybe Event
|
||||||
|
, transactionId : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the event's age, if at all provided by the homeserver.
|
||||||
|
-}
|
||||||
|
age : Event -> Maybe Int
|
||||||
|
age event =
|
||||||
|
Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode an Event from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : D.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)
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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 )
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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.andThen (\(UnsignedData data) -> data.prevContent) event.unsigned
|
||||||
|
|
||||||
|
|
||||||
|
{-| If the event has been redacted, the homeserver can display the event that
|
||||||
|
redacted it here.
|
||||||
|
-}
|
||||||
|
redactedBecause : Event -> Maybe Event
|
||||||
|
redactedBecause event =
|
||||||
|
Maybe.andThen (\(UnsignedData data) -> data.redactedBecause) event.unsigned
|
||||||
|
|
||||||
|
|
||||||
|
{-| If the user has sent this event to the homeserver, then the homeserver might
|
||||||
|
display the original transaction id used for the event.
|
||||||
|
-}
|
||||||
|
transactionId : Event -> Maybe String
|
||||||
|
transactionId event =
|
||||||
|
Maybe.andThen (\(UnsignedData data) -> data.transactionId) event.unsigned
|
|
@ -0,0 +1,93 @@
|
||||||
|
module Internal.Values.Settings exposing
|
||||||
|
( Settings, init
|
||||||
|
, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Settings
|
||||||
|
|
||||||
|
The Settings module exposes a data type to configure settings in the enveloped
|
||||||
|
data types.
|
||||||
|
|
||||||
|
@docs Settings, init
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs 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
|
||||||
|
|
||||||
|
|
||||||
|
{-| Custom settings that can be manipulated by the user. These serve as a
|
||||||
|
configuration for how the Elm SDK should behave.
|
||||||
|
|
||||||
|
Custom settings are always part of the Envelope, allowing all functions to
|
||||||
|
behave under the user's preferred settings.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias Settings =
|
||||||
|
{ currentVersion : String
|
||||||
|
, deviceName : String
|
||||||
|
, syncTime : Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode settings from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : D.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)
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a new Settings module based on default values
|
||||||
|
-}
|
||||||
|
init : Settings
|
||||||
|
init =
|
||||||
|
{ currentVersion = Default.currentVersion
|
||||||
|
, deviceName = Default.deviceName
|
||||||
|
, syncTime = Default.syncTime
|
||||||
|
}
|
|
@ -0,0 +1,277 @@
|
||||||
|
module Internal.Values.StateManager exposing
|
||||||
|
( StateManager
|
||||||
|
, empty, singleton, insert, remove, append
|
||||||
|
, isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
, keys, values, fromList, toList
|
||||||
|
, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| 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.
|
||||||
|
|
||||||
|
|
||||||
|
## Dictionaries
|
||||||
|
|
||||||
|
@docs StateManager
|
||||||
|
|
||||||
|
|
||||||
|
## Build
|
||||||
|
|
||||||
|
@docs empty, singleton, insert, remove, append
|
||||||
|
|
||||||
|
|
||||||
|
## Query
|
||||||
|
|
||||||
|
@docs isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
|
||||||
|
|
||||||
|
## Lists
|
||||||
|
|
||||||
|
@docs keys, values, fromList, toList
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs encode, decoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
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
|
||||||
|
their details.
|
||||||
|
-}
|
||||||
|
type StateManager
|
||||||
|
= StateManager (Dict String (Mashdict Event))
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a new statemanager on top of an existing StateManager. This can be
|
||||||
|
useful when trying to calculate a room state based on two already existing
|
||||||
|
types.
|
||||||
|
-}
|
||||||
|
append : StateManager -> StateManager -> StateManager
|
||||||
|
append sm2 sm1 =
|
||||||
|
List.foldl insert sm1 (values sm2)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- {-| Remove any floating empty Mashdicts from ALL keys in the dictionary.
|
||||||
|
-- -}
|
||||||
|
-- cleanAll : StateManager -> StateManager
|
||||||
|
-- cleanAll ((StateManager manager) as sm) =
|
||||||
|
-- List.foldl cleanKey sm (Dict.keys manager)
|
||||||
|
|
||||||
|
|
||||||
|
{-| To keep the StateManager as simple as possible, you can keep the dictionary
|
||||||
|
clean by removing any floating empty Mashdicts in the dictionary.
|
||||||
|
|
||||||
|
To save time, this function exclusively removes an empty Mashdict at a given
|
||||||
|
key. This way, you don't need to run a complete clean of a large dictionary
|
||||||
|
every time you just edit a single key in the dictionary.
|
||||||
|
|
||||||
|
-}
|
||||||
|
cleanKey : String -> StateManager -> StateManager
|
||||||
|
cleanKey key (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.update key
|
||||||
|
(Maybe.andThen
|
||||||
|
(\dict ->
|
||||||
|
if Mashdict.isEmpty dict then
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
else
|
||||||
|
Just dict
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|> StateManager
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a StateManager from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : D.Decoder StateManager
|
||||||
|
decoder =
|
||||||
|
Event.decoder
|
||||||
|
|> Mashdict.decoder .stateKey
|
||||||
|
|> D.keyValuePairs
|
||||||
|
|> D.map Dict.fromList
|
||||||
|
|> D.map StateManager
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create an empty StateManager.
|
||||||
|
-}
|
||||||
|
empty : StateManager
|
||||||
|
empty =
|
||||||
|
StateManager Dict.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)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Build a StateManager using a list of events.
|
||||||
|
-}
|
||||||
|
fromList : List Event -> StateManager
|
||||||
|
fromList events =
|
||||||
|
List.foldl insert empty events
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an event based on its event type and state key. If there is no such
|
||||||
|
event sent in the room, the function returns `Nothing`.
|
||||||
|
-}
|
||||||
|
get : { eventType : String, stateKey : String } -> StateManager -> Maybe Event
|
||||||
|
get { eventType, stateKey } (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.get eventType
|
||||||
|
|> Maybe.andThen (Mashdict.get stateKey)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a new event into the state manager. If the event does not have a
|
||||||
|
state key, it is overlooked.
|
||||||
|
-}
|
||||||
|
insert : Event -> StateManager -> StateManager
|
||||||
|
insert event (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.update
|
||||||
|
event.eventType
|
||||||
|
(\typeDict ->
|
||||||
|
case typeDict of
|
||||||
|
Nothing ->
|
||||||
|
Just <| Mashdict.singleton .stateKey event
|
||||||
|
|
||||||
|
Just md ->
|
||||||
|
Just <| Mashdict.insert event md
|
||||||
|
)
|
||||||
|
|> StateManager
|
||||||
|
|> cleanKey event.eventType
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine whether the StateManager contains any events.
|
||||||
|
-}
|
||||||
|
isEmpty : StateManager -> Bool
|
||||||
|
isEmpty (StateManager manager) =
|
||||||
|
Dict.isEmpty manager
|
||||||
|
|
||||||
|
|
||||||
|
{-| Since the StateManager's internal structure prevents Elm from making (==)
|
||||||
|
comparisons, the `isEqual` function allows you to make comparisons that ignore
|
||||||
|
the incomparable function.
|
||||||
|
-}
|
||||||
|
isEqual : StateManager -> StateManager -> Bool
|
||||||
|
isEqual (StateManager sm1) (StateManager sm2) =
|
||||||
|
if Dict.size sm1 /= Dict.size sm2 then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if Dict.keys sm1 /= Dict.keys sm2 then
|
||||||
|
False
|
||||||
|
|
||||||
|
else
|
||||||
|
List.all
|
||||||
|
(\key ->
|
||||||
|
case ( Dict.get key sm1, Dict.get key sm2 ) of
|
||||||
|
( Just s1, Just s2 ) ->
|
||||||
|
Mashdict.isEqual s1 s2
|
||||||
|
|
||||||
|
( _, _ ) ->
|
||||||
|
False
|
||||||
|
)
|
||||||
|
(Dict.keys sm1)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Retrieve all keys from a StateManager.
|
||||||
|
-}
|
||||||
|
keys : StateManager -> List { eventType : String, stateKey : String }
|
||||||
|
keys (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.toList
|
||||||
|
|> List.map
|
||||||
|
(\( eventType, dict ) ->
|
||||||
|
dict
|
||||||
|
|> Mashdict.keys
|
||||||
|
|> List.map
|
||||||
|
(\stateKey ->
|
||||||
|
{ eventType = eventType, stateKey = stateKey }
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|> List.concat
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine whether an event is part of the StateManager.
|
||||||
|
-}
|
||||||
|
member : Event -> StateManager -> Bool
|
||||||
|
member event (StateManager manager) =
|
||||||
|
case Dict.get event.eventType manager of
|
||||||
|
Just dict ->
|
||||||
|
Mashdict.member event dict
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
False
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine whether a given key is part of the StateManager.
|
||||||
|
-}
|
||||||
|
memberKey : { eventType : String, stateKey : String } -> StateManager -> Bool
|
||||||
|
memberKey { eventType, stateKey } (StateManager manager) =
|
||||||
|
case Dict.get eventType manager of
|
||||||
|
Just dict ->
|
||||||
|
Mashdict.memberKey stateKey dict
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
False
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get a StateManager without a given event in it. If the StateManager already
|
||||||
|
doesn't have the event, nothing changes.
|
||||||
|
-}
|
||||||
|
remove : Event -> StateManager -> StateManager
|
||||||
|
remove event (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.update event.eventType (Maybe.map (Mashdict.remove event))
|
||||||
|
|> StateManager
|
||||||
|
|> cleanKey event.eventType
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a StateManager that contains a single event.
|
||||||
|
-}
|
||||||
|
singleton : Event -> StateManager
|
||||||
|
singleton event =
|
||||||
|
insert event empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the StateManager's size by the amount of events.
|
||||||
|
-}
|
||||||
|
size : StateManager -> Int
|
||||||
|
size (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.values
|
||||||
|
|> List.map Mashdict.size
|
||||||
|
|> List.sum
|
||||||
|
|
||||||
|
|
||||||
|
{-| Transform the StateManager to a list of events.
|
||||||
|
-}
|
||||||
|
toList : StateManager -> List Event
|
||||||
|
toList =
|
||||||
|
values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the values from the StateManager, ordered by their event type (and by
|
||||||
|
their state key, if multiple events are of the same event type).
|
||||||
|
-}
|
||||||
|
values : StateManager -> List Event
|
||||||
|
values (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.values
|
||||||
|
|> List.map Mashdict.values
|
||||||
|
|> List.concat
|
|
@ -6,10 +6,8 @@ module Internal.Values.Vault exposing (Vault)
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Internal.Values.Envelope as Envelope
|
|
||||||
|
|
||||||
|
|
||||||
{-| This is the Vault type.
|
{-| This is the Vault type.
|
||||||
-}
|
-}
|
||||||
type alias Vault =
|
type alias Vault =
|
||||||
Envelope.Envelope {}
|
()
|
||||||
|
|
|
@ -0,0 +1,143 @@
|
||||||
|
module Matrix.Event exposing
|
||||||
|
( Event, content, eventType, stateKey
|
||||||
|
, eventId, roomId, sender, originServerTs
|
||||||
|
, previousContent, redactedBecause
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Matrix Events
|
||||||
|
|
||||||
|
This module contains all the functions necessary to view and manipulate Matrix
|
||||||
|
events.
|
||||||
|
|
||||||
|
|
||||||
|
## Event
|
||||||
|
|
||||||
|
@docs Event, content, eventType, stateKey
|
||||||
|
|
||||||
|
|
||||||
|
## Metadata
|
||||||
|
|
||||||
|
@docs eventId, roomId, sender, originServerTs
|
||||||
|
|
||||||
|
|
||||||
|
## Optional data
|
||||||
|
|
||||||
|
Occasionally, the Event might bring some extra information. Given how this
|
||||||
|
information isn't always applicable, it doesn't always exist.
|
||||||
|
|
||||||
|
@docs previousContent, redactedBecause
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Values.Envelope as Envelope
|
||||||
|
import Internal.Values.Event as Internal
|
||||||
|
import Json.Encode
|
||||||
|
import Time
|
||||||
|
import Types exposing (Event(..))
|
||||||
|
|
||||||
|
|
||||||
|
{-| In Matrix, the primary form of communication is to send JSON values to one
|
||||||
|
another. These JSON values, together with their metadata, are bundled into Event
|
||||||
|
types. They contain information like:
|
||||||
|
|
||||||
|
- Who sent the JSON value
|
||||||
|
- How they intend you to decode it
|
||||||
|
- When they sent it
|
||||||
|
- In what room they sent it
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias Event =
|
||||||
|
Types.Event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Receive the body of an Event, as created by the user that sent it.
|
||||||
|
-}
|
||||||
|
content : Event -> Json.Encode.Value
|
||||||
|
content (Event event) =
|
||||||
|
Envelope.extract .content event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the globally unique identifier for an event.
|
||||||
|
-}
|
||||||
|
eventId : Event -> String
|
||||||
|
eventId (Event event) =
|
||||||
|
Envelope.extract .eventId event
|
||||||
|
|
||||||
|
|
||||||
|
{-| To give a hint what the event's [content](#content) might look like, users
|
||||||
|
can use this eventType value to hint at how the JSON might be decoded.
|
||||||
|
|
||||||
|
Standard examples of event types are `m.room.message`, `m.room.member` and
|
||||||
|
`me.noordstar.game.chess.move`.
|
||||||
|
|
||||||
|
-}
|
||||||
|
eventType : Event -> String
|
||||||
|
eventType (Event event) =
|
||||||
|
Envelope.extract .eventType event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the timestamp of at what time the event was originally received by
|
||||||
|
the original homeserver.
|
||||||
|
|
||||||
|
Generally, this timestamp offers a relatively accurate indicator of when a
|
||||||
|
message was sent. However, this number isn't completely reliable! The timestamp
|
||||||
|
can be far in the past due to long network lag, and a (malicious) homeserver can
|
||||||
|
spoof this number to make it seem like something was sent ridiculously far in
|
||||||
|
the past - or even in the future.
|
||||||
|
|
||||||
|
-}
|
||||||
|
originServerTs : Event -> Time.Posix
|
||||||
|
originServerTs (Event event) =
|
||||||
|
Envelope.extract .originServerTs event
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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.
|
||||||
|
-}
|
||||||
|
previousContent : Event -> Maybe Json.Encode.Value
|
||||||
|
previousContent (Event event) =
|
||||||
|
Envelope.extract Internal.prevContent event
|
||||||
|
|
||||||
|
|
||||||
|
{-| If the event has been redacted, the homeserver can display the event that
|
||||||
|
redacted it here.
|
||||||
|
-}
|
||||||
|
redactedBecause : Event -> Maybe Event
|
||||||
|
redactedBecause (Event event) =
|
||||||
|
Envelope.mapMaybe Internal.redactedBecause event
|
||||||
|
|> Maybe.map Event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Unique id assigned to the Matrix room. You can use this room id to reference
|
||||||
|
or look up rooms.
|
||||||
|
-}
|
||||||
|
roomId : Event -> String
|
||||||
|
roomId (Event event) =
|
||||||
|
Envelope.extract .roomId event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the fully-qualified ID of the user who sent an event.
|
||||||
|
-}
|
||||||
|
sender : Event -> String
|
||||||
|
sender (Event event) =
|
||||||
|
Envelope.extract .sender event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine an event's state key.
|
||||||
|
|
||||||
|
It is present if, and only if, the event is a _state_ event. The key makes the
|
||||||
|
piece of state unique in the room. Note that it is often `Just ""`. If it is not
|
||||||
|
present, its value is `Nothing`.
|
||||||
|
|
||||||
|
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'd ID as the state key can only be set by that user.
|
||||||
|
|
||||||
|
-}
|
||||||
|
stateKey : Event -> Maybe String
|
||||||
|
stateKey (Event event) =
|
||||||
|
Envelope.extract .stateKey event
|
|
@ -1,4 +1,4 @@
|
||||||
module Types exposing (Vault(..))
|
module Types exposing (Vault(..), Event(..))
|
||||||
|
|
||||||
{-| The Elm SDK uses a lot of records and values that are easy to manipulate.
|
{-| The Elm SDK uses a lot of records and values that are easy to manipulate.
|
||||||
Yet, the [Elm design guidelines](https://package.elm-lang.org/help/design-guidelines#keep-tags-and-record-constructors-secret)
|
Yet, the [Elm design guidelines](https://package.elm-lang.org/help/design-guidelines#keep-tags-and-record-constructors-secret)
|
||||||
|
@ -12,14 +12,22 @@ access their content directly.
|
||||||
The opaque types are placed in a central module so all exposed modules can
|
The opaque types are placed in a central module so all exposed modules can
|
||||||
safely access all exposed data types without risking to create circular imports.
|
safely access all exposed data types without risking to create circular imports.
|
||||||
|
|
||||||
@docs Vault
|
@docs Vault, Event
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import Internal.Values.Envelope as Envelope
|
||||||
|
import Internal.Values.Event as Event
|
||||||
import Internal.Values.Vault as Vault
|
import Internal.Values.Vault as Vault
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type for Matrix Event
|
||||||
|
-}
|
||||||
|
type Event
|
||||||
|
= Event (Envelope.Envelope Event.Event)
|
||||||
|
|
||||||
|
|
||||||
{-| Opaque type for Matrix Vault
|
{-| Opaque type for Matrix Vault
|
||||||
-}
|
-}
|
||||||
type Vault
|
type Vault
|
||||||
= Vault Vault.Vault
|
= Vault (Envelope.Envelope Vault.Vault)
|
||||||
|
|
|
@ -0,0 +1,35 @@
|
||||||
|
module Test.Matrix.Settings exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz
|
||||||
|
import Matrix.Settings
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Types as TestTypes
|
||||||
|
|
||||||
|
|
||||||
|
settings : Test
|
||||||
|
settings =
|
||||||
|
describe "Exposed Matrix.Settings"
|
||||||
|
[ describe "Set values"
|
||||||
|
[ fuzz2 TestTypes.vault
|
||||||
|
Fuzz.string
|
||||||
|
"Set device name"
|
||||||
|
(\vault name ->
|
||||||
|
vault
|
||||||
|
|> Matrix.Settings.setDeviceName name
|
||||||
|
|> Matrix.Settings.getDeviceName
|
||||||
|
|> Expect.equal name
|
||||||
|
)
|
||||||
|
, fuzz2 TestTypes.vault
|
||||||
|
Fuzz.int
|
||||||
|
"Set sync time"
|
||||||
|
(\vault sync ->
|
||||||
|
vault
|
||||||
|
|> Matrix.Settings.setSyncTime sync
|
||||||
|
|> Matrix.Settings.getSyncTime
|
||||||
|
|> Expect.equal sync
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
-- , describe "Read values" []
|
||||||
|
]
|
|
@ -0,0 +1,174 @@
|
||||||
|
module Test.Tools.Hashdict exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
|
import Internal.Values.Event as Event
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : (a -> String) -> Fuzzer a -> Fuzzer (Hashdict a)
|
||||||
|
fuzzer toHash fuz =
|
||||||
|
Fuzz.map (Hashdict.fromList toHash) (Fuzz.list fuz)
|
||||||
|
|
||||||
|
|
||||||
|
eventFuzzer : Fuzzer (Hashdict Event.Event)
|
||||||
|
eventFuzzer =
|
||||||
|
fuzzer .eventId TestEvent.fuzzer
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Hashdict"
|
||||||
|
[ describe "empty"
|
||||||
|
[ test "empty isEmpty"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.isEmpty
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Nothing is member"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.empty .eventId
|
||||||
|
|> Hashdict.member event
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"No key is member"
|
||||||
|
(\key ->
|
||||||
|
Hashdict.empty identity
|
||||||
|
|> Hashdict.memberKey key
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"Get gets Nothing"
|
||||||
|
(\key ->
|
||||||
|
Hashdict.empty identity
|
||||||
|
|> Hashdict.get key
|
||||||
|
|> Expect.equal Nothing
|
||||||
|
)
|
||||||
|
, test "Size is zero"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.size
|
||||||
|
|> Expect.equal 0
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No keys"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.keys
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No values"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.values
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "To list is []"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.toList
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "From list is empty"
|
||||||
|
([]
|
||||||
|
|> Hashdict.fromList (\x -> x)
|
||||||
|
|> Hashdict.isEqual (Hashdict.empty identity)
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Empty + empty == empty"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.union (Hashdict.empty String.toUpper)
|
||||||
|
|> Hashdict.isEqual (Hashdict.empty String.toLower)
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz (Fuzz.intRange 0 10)
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\indent ->
|
||||||
|
Hashdict.empty identity
|
||||||
|
|> Hashdict.encode E.string
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Hashdict.decoder identity D.string)
|
||||||
|
|> Result.map (Hashdict.isEqual (Hashdict.empty String.toUpper))
|
||||||
|
|> Expect.equal (Ok True)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "singleton"
|
||||||
|
[ fuzz TestEvent.fuzzer
|
||||||
|
"singletong = empty + insert"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.empty .eventId
|
||||||
|
|> Hashdict.insert event
|
||||||
|
|> Hashdict.isEqual (Hashdict.singleton .eventId event)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Singleton - event = empty"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.remove event
|
||||||
|
|> Hashdict.isEqual (Hashdict.empty .sender)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Singletong - event (key) = empty"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.removeKey event.eventId
|
||||||
|
|> Hashdict.isEqual (Hashdict.empty .sender)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"not isEmpty"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.isEmpty
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"member"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.member event
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"memberKey"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.memberKey event.eventId
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"False memberKey"
|
||||||
|
(\event ->
|
||||||
|
if event.eventId == event.roomId then
|
||||||
|
Expect.pass
|
||||||
|
|
||||||
|
else
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.memberKey event.roomId
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "JSON"
|
||||||
|
[ fuzz2 eventFuzzer
|
||||||
|
(Fuzz.intRange 0 10)
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\hashdict indent ->
|
||||||
|
hashdict
|
||||||
|
|> Hashdict.encode Event.encode
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Hashdict.decoder .eventId Event.decoder)
|
||||||
|
|> Result.map Hashdict.toList
|
||||||
|
|> Expect.equal (Ok <| Hashdict.toList hashdict)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -1,4 +1,4 @@
|
||||||
module Iddict exposing (..)
|
module Test.Tools.Iddict exposing (..)
|
||||||
|
|
||||||
import Expect
|
import Expect
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
|
@ -0,0 +1,204 @@
|
||||||
|
module Test.Tools.Mashdict exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Tools.Mashdict as Mashdict exposing (Mashdict)
|
||||||
|
import Internal.Values.Event as Event
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : (a -> Maybe String) -> Fuzzer a -> Fuzzer (Mashdict a)
|
||||||
|
fuzzer toHash fuz =
|
||||||
|
Fuzz.map (Mashdict.fromList toHash) (Fuzz.list fuz)
|
||||||
|
|
||||||
|
|
||||||
|
eventFuzzer : Fuzzer (Mashdict Event.Event)
|
||||||
|
eventFuzzer =
|
||||||
|
fuzzer .stateKey TestEvent.fuzzer
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Mashdict"
|
||||||
|
[ describe "empty"
|
||||||
|
[ test "empty isEmpty"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.isEmpty
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Nothing is member"
|
||||||
|
(\event ->
|
||||||
|
Mashdict.empty .stateKey
|
||||||
|
|> Mashdict.member event
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"No key is member"
|
||||||
|
(\key ->
|
||||||
|
Mashdict.empty identity
|
||||||
|
|> Mashdict.memberKey key
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"Get gets Nothing"
|
||||||
|
(\key ->
|
||||||
|
Mashdict.empty identity
|
||||||
|
|> Mashdict.get key
|
||||||
|
|> Expect.equal Nothing
|
||||||
|
)
|
||||||
|
, test "Size is zero"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.size
|
||||||
|
|> Expect.equal 0
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No keys"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.keys
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No values"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.values
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "To list is []"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.toList
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "From list is empty"
|
||||||
|
([]
|
||||||
|
|> Mashdict.fromList (\x -> x)
|
||||||
|
|> Mashdict.isEqual (Mashdict.empty identity)
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Empty + empty == empty"
|
||||||
|
(Mashdict.empty Maybe.Just
|
||||||
|
|> Mashdict.union (Mashdict.empty Maybe.Just)
|
||||||
|
|> Mashdict.isEqual (Mashdict.empty Maybe.Just)
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz (Fuzz.intRange 0 10)
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\indent ->
|
||||||
|
Mashdict.empty Just
|
||||||
|
|> Mashdict.encode E.string
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Mashdict.decoder Just D.string)
|
||||||
|
|> Result.map (Mashdict.isEqual (Mashdict.empty Just))
|
||||||
|
|> Expect.equal (Ok True)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "singleton"
|
||||||
|
[ fuzz TestEvent.fuzzer
|
||||||
|
"singleton = empty + insert"
|
||||||
|
(\event ->
|
||||||
|
Mashdict.empty .stateKey
|
||||||
|
|> Mashdict.insert event
|
||||||
|
|> Mashdict.isEqual (Mashdict.singleton .stateKey event)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"singleton - event = empty"
|
||||||
|
(\event ->
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.remove event
|
||||||
|
|> Mashdict.isEqual (Mashdict.empty (always Nothing))
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"singleton - event (key) = empty"
|
||||||
|
(\event ->
|
||||||
|
case event.stateKey of
|
||||||
|
Just key ->
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.removeKey key
|
||||||
|
|> Mashdict.isEqual (Mashdict.empty .stateKey)
|
||||||
|
|> Expect.equal True
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Expect.pass
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Only isEmpty when not Nothing"
|
||||||
|
(\event ->
|
||||||
|
Expect.equal
|
||||||
|
(case event.stateKey of
|
||||||
|
Just _ ->
|
||||||
|
False
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
True
|
||||||
|
)
|
||||||
|
(event
|
||||||
|
|> Mashdict.singleton .stateKey
|
||||||
|
|> Mashdict.isEmpty
|
||||||
|
)
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"member"
|
||||||
|
(\event ->
|
||||||
|
Expect.equal
|
||||||
|
(case event.stateKey of
|
||||||
|
Just _ ->
|
||||||
|
True
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
False
|
||||||
|
)
|
||||||
|
(Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.member event
|
||||||
|
)
|
||||||
|
)
|
||||||
|
, fuzz2 TestEvent.fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
"memberKey"
|
||||||
|
(\event rkey ->
|
||||||
|
case event.stateKey of
|
||||||
|
Just key ->
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.memberKey key
|
||||||
|
|> Expect.equal True
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.memberKey rkey
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"False memberKey"
|
||||||
|
(\event ->
|
||||||
|
if event.stateKey == Just event.roomId then
|
||||||
|
Expect.pass
|
||||||
|
|
||||||
|
else
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.memberKey event.roomId
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "JSON"
|
||||||
|
[ fuzz2 eventFuzzer
|
||||||
|
(Fuzz.intRange 0 10)
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\hashdict indent ->
|
||||||
|
hashdict
|
||||||
|
|> Mashdict.encode Event.encode
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Mashdict.decoder .stateKey Event.decoder)
|
||||||
|
|> Result.map Mashdict.toList
|
||||||
|
|> Expect.equal (Ok <| Mashdict.toList hashdict)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,66 @@
|
||||||
|
module Test.Tools.Timestamp exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Timestamp
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.map Time.millisToPosix Fuzz.int
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Timestamp"
|
||||||
|
[ describe "JSON"
|
||||||
|
[ fuzz2 fuzzer
|
||||||
|
Fuzz.int
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\time indent ->
|
||||||
|
time
|
||||||
|
|> Timestamp.encode
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString Timestamp.decoder
|
||||||
|
|> Expect.equal (Ok time)
|
||||||
|
)
|
||||||
|
, fuzz fuzzer
|
||||||
|
"JSON decode -> millis"
|
||||||
|
(\time ->
|
||||||
|
time
|
||||||
|
|> Timestamp.encode
|
||||||
|
|> D.decodeValue D.int
|
||||||
|
|> Expect.equal (Ok <| Time.posixToMillis time)
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.int
|
||||||
|
"JSON decode -> time"
|
||||||
|
(\n ->
|
||||||
|
n
|
||||||
|
|> E.int
|
||||||
|
|> D.decodeValue Timestamp.decoder
|
||||||
|
|> Expect.equal (Ok <| Time.millisToPosix n)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Identity"
|
||||||
|
[ fuzz fuzzer
|
||||||
|
"Posix -> int -> Posix"
|
||||||
|
(\time ->
|
||||||
|
time
|
||||||
|
|> Time.posixToMillis
|
||||||
|
|> Time.millisToPosix
|
||||||
|
|> Expect.equal time
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.int
|
||||||
|
"int -> Posix -> int"
|
||||||
|
(\n ->
|
||||||
|
n
|
||||||
|
|> Time.millisToPosix
|
||||||
|
|> Time.posixToMillis
|
||||||
|
|> Expect.equal n
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,17 @@
|
||||||
|
module Test.Types exposing (..)
|
||||||
|
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Test.Values.Envelope as TestEnvelope
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
import Test.Values.Vault as TestVault
|
||||||
|
import Types exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
event : Fuzzer Event
|
||||||
|
event =
|
||||||
|
Fuzz.map Event (TestEnvelope.fuzzer TestEvent.fuzzer)
|
||||||
|
|
||||||
|
|
||||||
|
vault : Fuzzer Vault
|
||||||
|
vault =
|
||||||
|
Fuzz.map Vault (TestEnvelope.fuzzer TestVault.vault)
|
|
@ -1,4 +1,4 @@
|
||||||
module Context exposing (..)
|
module Test.Values.Context exposing (..)
|
||||||
|
|
||||||
import Expect
|
import Expect
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
|
@ -0,0 +1,65 @@
|
||||||
|
module Test.Values.Envelope exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Config.Default as Default
|
||||||
|
import Internal.Values.Envelope as Envelope exposing (Envelope)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Context as TestContext
|
||||||
|
import Test.Values.Settings as TestSettings
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer a -> Fuzzer (Envelope a)
|
||||||
|
fuzzer fuz =
|
||||||
|
Fuzz.map3 Envelope
|
||||||
|
fuz
|
||||||
|
TestContext.fuzzer
|
||||||
|
TestSettings.fuzzer
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Envelope value"
|
||||||
|
[ describe "init"
|
||||||
|
[ describe "Default settings"
|
||||||
|
[ fuzz Fuzz.string
|
||||||
|
"currentVersion"
|
||||||
|
(\s ->
|
||||||
|
s
|
||||||
|
|> Envelope.init
|
||||||
|
|> Envelope.extractSettings .currentVersion
|
||||||
|
|> Expect.equal Default.currentVersion
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"deviceName"
|
||||||
|
(\s ->
|
||||||
|
s
|
||||||
|
|> Envelope.init
|
||||||
|
|> Envelope.extractSettings .deviceName
|
||||||
|
|> Expect.equal Default.deviceName
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"syncTime"
|
||||||
|
(\s ->
|
||||||
|
s
|
||||||
|
|> Envelope.init
|
||||||
|
|> Envelope.extractSettings .syncTime
|
||||||
|
|> Expect.equal Default.syncTime
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
||||||
|
, describe "JSON"
|
||||||
|
[ fuzz2 (fuzzer Fuzz.string)
|
||||||
|
Fuzz.int
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\envelope indent ->
|
||||||
|
envelope
|
||||||
|
|> Envelope.encode E.string
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Envelope.decoder D.string)
|
||||||
|
|> Expect.equal (Ok envelope)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,67 @@
|
||||||
|
module Test.Values.Event exposing (..)
|
||||||
|
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Values.Event as Event exposing (Event)
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Tools.Timestamp as TestTimestamp
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Event
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.map8 Event
|
||||||
|
valueFuzzer
|
||||||
|
Fuzz.string
|
||||||
|
TestTimestamp.fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
Fuzz.string
|
||||||
|
(Fuzz.maybe Fuzz.string)
|
||||||
|
Fuzz.string
|
||||||
|
(Fuzz.maybe unsignedDataFuzzer)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Fuzzer for an event with a set state key
|
||||||
|
-}
|
||||||
|
fuzzerState : Fuzzer Event
|
||||||
|
fuzzerState =
|
||||||
|
Fuzz.map2
|
||||||
|
(\event default ->
|
||||||
|
{ event
|
||||||
|
| stateKey =
|
||||||
|
event.stateKey
|
||||||
|
|> Maybe.withDefault default
|
||||||
|
|> Maybe.Just
|
||||||
|
}
|
||||||
|
)
|
||||||
|
fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
|
||||||
|
|
||||||
|
unsignedDataFuzzer : Fuzzer Event.UnsignedData
|
||||||
|
unsignedDataFuzzer =
|
||||||
|
Fuzz.map4
|
||||||
|
(\age prev redact trans ->
|
||||||
|
Event.UnsignedData
|
||||||
|
{ age = age
|
||||||
|
, prevContent = prev
|
||||||
|
, redactedBecause = redact
|
||||||
|
, transactionId = trans
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Fuzz.maybe Fuzz.int)
|
||||||
|
(Fuzz.maybe valueFuzzer)
|
||||||
|
(Fuzz.maybe <| Fuzz.lazy (\_ -> fuzzer))
|
||||||
|
(Fuzz.maybe Fuzz.string)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Example values that can be used for arbitrary JSON values
|
||||||
|
-}
|
||||||
|
valueFuzzer : Fuzzer E.Value
|
||||||
|
valueFuzzer =
|
||||||
|
Fuzz.oneOf
|
||||||
|
[ Fuzz.map E.int Fuzz.int
|
||||||
|
, Fuzz.map E.string Fuzz.string
|
||||||
|
, Fuzz.map (E.list E.int) (Fuzz.list Fuzz.int)
|
||||||
|
, Fuzz.map (E.list E.string) (Fuzz.list Fuzz.string)
|
||||||
|
, Fuzz.map Event.encode (Fuzz.lazy (\_ -> fuzzer))
|
||||||
|
]
|
|
@ -0,0 +1,80 @@
|
||||||
|
module Test.Values.Settings exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Config.Default as Default
|
||||||
|
import Internal.Values.Settings as Settings exposing (Settings)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Settings
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.map3 Settings
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.constant Default.currentVersion
|
||||||
|
, Fuzz.string
|
||||||
|
]
|
||||||
|
)
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.constant Default.deviceName
|
||||||
|
, Fuzz.string
|
||||||
|
]
|
||||||
|
)
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.constant Default.syncTime
|
||||||
|
, Fuzz.int
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Settings"
|
||||||
|
[ describe "init"
|
||||||
|
[ test "Current version"
|
||||||
|
(Settings.init
|
||||||
|
|> .currentVersion
|
||||||
|
|> Expect.equal Default.currentVersion
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Device name"
|
||||||
|
(Settings.init
|
||||||
|
|> .deviceName
|
||||||
|
|> Expect.equal Default.deviceName
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Sync time"
|
||||||
|
(Settings.init
|
||||||
|
|> .syncTime
|
||||||
|
|> Expect.equal Default.syncTime
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "JSON encode init is {}"
|
||||||
|
(Settings.init
|
||||||
|
|> Settings.encode
|
||||||
|
|> E.encode 0
|
||||||
|
|> Expect.equal "{}"
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "JSON decode {} is init"
|
||||||
|
("{}"
|
||||||
|
|> D.decodeString Settings.decoder
|
||||||
|
|> Expect.equal (Ok Settings.init)
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "JSON"
|
||||||
|
[ fuzz2 fuzzer
|
||||||
|
Fuzz.int
|
||||||
|
"JSON encode -> JSON decode -> identical"
|
||||||
|
(\settings indent ->
|
||||||
|
settings
|
||||||
|
|> Settings.encode
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString Settings.decoder
|
||||||
|
|> Expect.equal (Ok settings)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,138 @@
|
||||||
|
module Test.Values.StateManager exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Values.StateManager as StateManager exposing (StateManager)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer StateManager
|
||||||
|
fuzzer =
|
||||||
|
TestEvent.fuzzer
|
||||||
|
|> Fuzz.list
|
||||||
|
|> Fuzz.map StateManager.fromList
|
||||||
|
|
||||||
|
|
||||||
|
fuzzerKey : Fuzzer { eventType : String, stateKey : String }
|
||||||
|
fuzzerKey =
|
||||||
|
Fuzz.map2
|
||||||
|
(\a b -> { eventType = a, stateKey = b })
|
||||||
|
Fuzz.string
|
||||||
|
Fuzz.string
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "StateManager"
|
||||||
|
[ describe "empty"
|
||||||
|
[ test "empty isEmpty"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.isEmpty
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"empty has no member"
|
||||||
|
(\event ->
|
||||||
|
StateManager.empty
|
||||||
|
|> StateManager.member event
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz fuzzerKey
|
||||||
|
"empty has no memberKey"
|
||||||
|
(\key ->
|
||||||
|
StateManager.empty
|
||||||
|
|> StateManager.memberKey key
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz fuzzerKey
|
||||||
|
"Empty gets Nothing"
|
||||||
|
(\key ->
|
||||||
|
StateManager.empty
|
||||||
|
|> StateManager.get key
|
||||||
|
|> Expect.equal Nothing
|
||||||
|
)
|
||||||
|
, test "Empty has no keys"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.keys
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Empty has no values"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.values
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "toList empty equals []"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.toList
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "fromList [] equals empty"
|
||||||
|
([]
|
||||||
|
|> StateManager.fromList
|
||||||
|
|> Expect.equal StateManager.empty
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "JSON encode -> JSON decode remains empty"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.encode
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString StateManager.decoder
|
||||||
|
|> Expect.equal (Ok StateManager.empty)
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "singleton"
|
||||||
|
[ fuzz TestEvent.fuzzerState
|
||||||
|
"singleton = empty + event"
|
||||||
|
(\event ->
|
||||||
|
StateManager.empty
|
||||||
|
|> StateManager.insert event
|
||||||
|
|> StateManager.isEqual (StateManager.singleton event)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzerState
|
||||||
|
"singleton - event = empty"
|
||||||
|
(\event ->
|
||||||
|
StateManager.singleton event
|
||||||
|
|> StateManager.remove event
|
||||||
|
|> StateManager.isEqual StateManager.empty
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzerState
|
||||||
|
"singleton has one member"
|
||||||
|
(\event ->
|
||||||
|
StateManager.singleton event
|
||||||
|
|> StateManager.member event
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
|
||||||
|
-- , fuzz2 TestEvent.fuzzerState TestEvent.fuzzerState
|
||||||
|
-- "singleton has no other members"
|
||||||
|
-- (\e1 e2 ->
|
||||||
|
-- if (Debug.log "To compare" e1) == e2 then
|
||||||
|
-- Expect.pass
|
||||||
|
-- else
|
||||||
|
-- ()
|
||||||
|
-- |> Debug.log "Not equal"
|
||||||
|
-- |> always (StateManager.singleton e1)
|
||||||
|
-- |> StateManager.member e2
|
||||||
|
-- |> Expect.equal False
|
||||||
|
-- )
|
||||||
|
, fuzz TestEvent.fuzzerState
|
||||||
|
"singleton has one value"
|
||||||
|
(\event ->
|
||||||
|
StateManager.singleton event
|
||||||
|
|> StateManager.values
|
||||||
|
|> Expect.equal [ event ]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
-- Write other tests here
|
||||||
|
]
|
|
@ -0,0 +1,10 @@
|
||||||
|
module Test.Values.Vault exposing (..)
|
||||||
|
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Values.Vault exposing (Vault)
|
||||||
|
import Test exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
vault : Fuzzer Vault
|
||||||
|
vault =
|
||||||
|
Fuzz.unit
|
|
@ -1,53 +0,0 @@
|
||||||
module Vault exposing (..)
|
|
||||||
|
|
||||||
import Expect
|
|
||||||
import Fuzz exposing (Fuzzer)
|
|
||||||
import Internal.Config.Default as Default
|
|
||||||
import Internal.Values.Envelope as Envelope
|
|
||||||
import Matrix
|
|
||||||
import Matrix.Settings
|
|
||||||
import Test exposing (..)
|
|
||||||
import Types
|
|
||||||
|
|
||||||
|
|
||||||
fuzzer : Fuzzer Matrix.Vault
|
|
||||||
fuzzer =
|
|
||||||
Fuzz.constant <| Types.Vault <| Envelope.init {}
|
|
||||||
|
|
||||||
|
|
||||||
settings : Test
|
|
||||||
settings =
|
|
||||||
describe "Edit settings"
|
|
||||||
[ fuzz fuzzer
|
|
||||||
"Default device name"
|
|
||||||
(\vault ->
|
|
||||||
vault
|
|
||||||
|> Matrix.Settings.getDeviceName
|
|
||||||
|> Expect.equal Default.deviceName
|
|
||||||
)
|
|
||||||
, fuzz2 fuzzer
|
|
||||||
Fuzz.string
|
|
||||||
"Set device name"
|
|
||||||
(\vault name ->
|
|
||||||
vault
|
|
||||||
|> Matrix.Settings.setDeviceName name
|
|
||||||
|> Matrix.Settings.getDeviceName
|
|
||||||
|> Expect.equal name
|
|
||||||
)
|
|
||||||
, fuzz fuzzer
|
|
||||||
"Default sync time"
|
|
||||||
(\vault ->
|
|
||||||
vault
|
|
||||||
|> Matrix.Settings.getSyncTime
|
|
||||||
|> Expect.equal Default.syncTime
|
|
||||||
)
|
|
||||||
, fuzz2 fuzzer
|
|
||||||
Fuzz.int
|
|
||||||
"Set sync time"
|
|
||||||
(\vault sync ->
|
|
||||||
vault
|
|
||||||
|> Matrix.Settings.setSyncTime sync
|
|
||||||
|> Matrix.Settings.getSyncTime
|
|
||||||
|> Expect.equal sync
|
|
||||||
)
|
|
||||||
]
|
|
Loading…
Reference in New Issue