Merge current data types to develop

Merge pull request #8 from noordstar/3-data-types
3-data-types
BramvdnHeuvel 2023-12-29 15:50:32 +01:00 committed by GitHub
commit 70f57b1b96
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
23 changed files with 1892 additions and 159 deletions

View File

@ -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": {

View File

@ -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

View File

@ -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

View File

@ -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,15 +138,10 @@ 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.init
, settings = }
{ currentVersion = Default.currentVersion
, deviceName = Default.deviceName
, syncTime = Default.syncTime
}
}
{-| Map a function on the content of the Envelope. {-| Map a function on the content of the Envelope.
@ -208,23 +155,18 @@ 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 }
}
{-| 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

View File

@ -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

View File

@ -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
}

View File

@ -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

View File

@ -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 {} ()

143
src/Matrix/Event.elm Normal file
View File

@ -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

View File

@ -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)

View File

@ -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" []
]

View File

@ -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)
)
]
]

View File

@ -1,4 +1,4 @@
module Iddict exposing (..) module Test.Tools.Iddict exposing (..)
import Expect import Expect
import Fuzz exposing (Fuzzer) import Fuzz exposing (Fuzzer)

View File

@ -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)
)
]
]

View File

@ -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
)
]
]

17
tests/Test/Types.elm Normal file
View File

@ -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)

View File

@ -1,4 +1,4 @@
module Context exposing (..) module Test.Values.Context exposing (..)
import Expect import Expect
import Fuzz exposing (Fuzzer) import Fuzz exposing (Fuzzer)

View File

@ -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)
)
]
]

View File

@ -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))
]

View File

@ -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)
)
]
]

View File

@ -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
]

View File

@ -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

View File

@ -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
)
]