noordstar
/
elm-matrix-sdk-beta
mirror of https://github.com/noordstar/elm-matrix-sdk-beta
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Compare commits

base: noordstar:ecdc136f9e24fd6db89f7403c6bdf7aaaf6901e8
Branches Tags
noordstar:main
noordstar:develop
noordstar:4-transfer-api
noordstar:patch-no-baseurl-found
noordstar:4-log-reader
noordstar:4-compiler-bug
noordstar:3-vault
noordstar:3-room
noordstar:parser
noordstar:json-docs
noordstar:3-timeline
noordstar:json-extra
noordstar:3-data-types
noordstar:3-state-manager
noordstar:elm-test
noordstar:3-event
noordstar:2-transfer-tools
noordstar:1-repo-setup
noordstar:3.5.0
noordstar:3.4.0
noordstar:3.3.1
noordstar:3.3.0
noordstar:3.2.0
noordstar:3.1.0
noordstar:3.0.0
noordstar:2.1.2
noordstar:2.1.1
noordstar:2.1.0
noordstar:2.0.0
noordstar:1.0.0
...
compare: noordstar:d1fbc87730b2143bbd9f34db938c808d5f4438e0
Branches Tags
noordstar:main
noordstar:develop
noordstar:4-transfer-api
noordstar:patch-no-baseurl-found
noordstar:4-log-reader
noordstar:4-compiler-bug
noordstar:3-vault
noordstar:3-room
noordstar:parser
noordstar:json-docs
noordstar:3-timeline
noordstar:json-extra
noordstar:3-data-types
noordstar:3-state-manager
noordstar:elm-test
noordstar:3-event
noordstar:2-transfer-tools
noordstar:1-repo-setup
noordstar:3.5.0
noordstar:3.4.0
noordstar:3.3.1
noordstar:3.3.0
noordstar:3.2.0
noordstar:3.1.0
noordstar:3.0.0
noordstar:2.1.2
noordstar:2.1.1
noordstar:2.1.0
noordstar:2.0.0
noordstar:1.0.0

3 Commits
ecdc136f9e ... d1fbc87730

Author SHA1 Message Date
Bram d1fbc87730 Refactor to new JSON coders 2024-01-19 16:22:51 +01:00
Bram 28d2a17a10 Add final features to JSON coder module 2024-01-19 16:21:41 +01:00
Bram 3f08e4a3e7 Add more high-level ary humans 2024-01-18 14:46:50 +01:00
13 changed files with 833 additions and 881 deletions
Show Stats Expand all files Collapse all files

131
src/Internal/Config/Text.elm
View File

@ -1,8 +1,9 @@
module Internal.Config.Text exposing
( accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid
( docs, failures, fields
, accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid
, versionsFoundLocally, versionsReceived, versionsFailedToDecode
, unsupportedVersionForEndpoint
, decodedDictSize, leakingValueFound
, decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound
)
{-| Throughout the Elm SDK, there are lots of pieces of text being used for
@ -24,6 +25,11 @@ This is a risky feature, keep in mind that even a patch update might break this!
You should only do this if you know what you're doing.
## Type documentation
@docs docs, failures, fields
## API Authentication
Messages sent as API logs during the authentication phase of the API
@ -53,11 +59,19 @@ Messages sent as API logs during communication with the API.
Messages sent as API logs when a JSON value is being decoded.
@docs decodedDictSize, leakingValueFound
@docs decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound
-}
type alias Desc =
List String
type alias TypeDocs =
{ name : String, description : Desc }
{-| Logs when the Matrix API returns that an access token is no longer valid.
-}
accessTokenExpired : String
@ -95,6 +109,117 @@ decodedDictSize from to =
]
{-| Documentation used for all functions and data types in JSON coders
-}
docs :
{ event : TypeDocs
, hashdict : TypeDocs
, mashdict : TypeDocs
, stateManager : TypeDocs
, unsigned : TypeDocs
}
docs =
{ event =
{ name = "Event"
, description =
[ "The Event type represents a single value that contains all the information for a single event in the room."
]
}
, hashdict =
{ name = "Hashdict"
, description =
[ "This allows you to store values based on an externally defined identifier."
, "For example, the hashdict can store events and use their event id as their key."
]
}
, mashdict =
{ name = "Mashdict"
, description =
[ "The mashdict exclusively stores values for which the hashing algorithm returns a value, and it ignores the outcome for all other scenarios."
]
}
, stateManager =
{ name = "StateManager"
, description =
[ "The StateManager tracks the room state based on events, their event types and the optional state keys they provide."
, "Instead of making the user loop through the room's timeline of events, the StateManager offers the user a dictionary-like experience to navigate through the Matrix room state."
]
}
, unsigned =
{ name = "Unsigned Data"
, description =
[ "Unsigned data is optional data that might come along with the event."
, "This information is often supportive but not necessary to the context."
]
}
}
{-| Description of all edge cases where a JSON decoder can fail.
-}
failures : { hashdict : Desc, mashdict : Desc }
failures =
{ hashdict =
[ "Not all values map to thir respected hash with the given hash function."
]
, mashdict =
[ "Not all values map to thir respected hash with the given hash function."
]
}
-- TODO
fields :
{ event :
{ content : Desc
, eventId : Desc
, originServerTs : Desc
, roomId : Desc
, sender : Desc
, stateKey : Desc
, eventType : Desc
, unsigned : Desc
}
, unsigned :
{ age : Desc
, prevContent : Desc
, redactedBecause : Desc
, transactionId : Desc
}
}
fields =
{ event =
{ content = []
, eventId = []
, originServerTs = []
, roomId = []
, sender = []
, stateKey = []
, eventType = []
, unsigned = []
}
, unsigned =
{ age = []
, prevContent = []
, redactedBecause = []
, transactionId = []
}
}
invalidHashInHashdict : String
invalidHashInHashdict =
"Invalid hash function: not all elements hash to their JSON-stored hashes"
invalidHashInMashdict : String
invalidHashInMashdict =
"Invalid hash function: not all elements hash to their JSON-stored hashes"
{-| The Elm SDK occassionally uses [leaking values](Internal-Config-Leaks),
which might indicate exceptional behaviour. As such, this log is sent when one
of those leaking values is found: to alert the user that something fishy might

691
src/Internal/Tools/Decode.elm
View File

@ -1,691 +0,0 @@
module Internal.Tools.Decode exposing
( Decoder, string, bool, int, float
, nullable, list, slowDict, fastDict, keyValuePairs
, field, at, index, opField, opFieldWithDefault
, maybe, oneOf
, map, map2, map3, map4, map5, map6, map7, map8, map9, map10, map11
, lazy, value, null, succeed, fail, andThen
, pString, pBool, pInt, pList
)
{-|
# Advanced security Json.Decode
This module extends the standard JSON encode / decode library for security
measures. Most Elm libraries do not access an API this often without insight
for the user, and hence this module aims to offer the user more insight into
what is going on.
Additionally, the decoder will warn for suspicious values, and provide helpful
errors when the JSON fails to decode.
## Primitives
@docs Decoder, string, bool, int, float
## Data structures
@docs nullable, list, slowDict, fastDict, keyValuePairs
## Object primitives
@docs field, at, index, opField, opFieldWithDefault
## Inconsistent structure
@docs maybe, oneOf
## Mapping
@docs map, map2, map3, map4, map5, map6, map7, map8, map9, map10, map11
## Fancy decoding
@docs lazy, value, null, succeed, fail, andThen
## Phantom decoding
Phantom decoders allow you to create phantom types of standard Elm types.
@docs pString, pBool, pInt, pList
-}
import Dict as SDict
import FastDict as FDict
import Internal.Config.Leaks as L
import Internal.Config.Log as Log
import Internal.Config.Phantom as Phantom
import Internal.Config.Text as Text
import Internal.Tools.DecodeExtra as D
import Json.Decode as D
import Set
{-| A value that knows how to decode JSON values.
-}
type alias Decoder a =
D.Decoder { content : a, messages : List ( String, String ) }
{-| Create decoders that depend on previous results.
-}
andThen : (a -> Decoder b) -> Decoder a -> Decoder b
andThen func =
D.andThen
(\a ->
D.map
(\b -> { b | messages = a.messages ++ b.messages })
(func a.content)
)
{-| Decode a nested JSON object, requiring certain fields.
-}
at : List String -> Decoder a -> Decoder a
at =
D.at
{-| Decode a JSON boolean into an Elm bool.
-}
bool : Decoder Bool
bool =
D.map empty D.bool
{-| Initialize a standard object for the decoder.
-}
empty : a -> { content : a, messages : List ( String, String ) }
empty x =
{ content = x, messages = [] }
{-| Ignore the JSON and make the decoder fail.
-}
fail : String -> Decoder a
fail =
D.fail
{-| Decode a JSON object into a fast Elm dict from miniBill/elm-fast-dict.
-}
fastDict : Decoder a -> Decoder (FDict.Dict String a)
fastDict x =
keyValuePairs x
|> andThen
(\pairs ->
let
dict =
FDict.fromList pairs
oldLength =
List.length pairs
newLength =
FDict.size dict
in
if oldLength == newLength then
succeed dict
else
D.succeed
{ content = dict
, messages =
[ ( Log.warn, Text.decodedDictSize oldLength newLength ) ]
}
)
{-| Decode a JSON object, requiring a particular field.
-}
field : String -> Decoder a -> Decoder a
field =
D.field
{-| Decode a JSON number into an Elm flaot.
-}
float : Decoder Float
float =
D.map empty D.float
{-| Decode a JSON array, requiring a particular index.
-}
index : Int -> Decoder a -> Decoder a
index =
D.index
{-| Decode a JSON number into an Elm int.
-}
int : Decoder Int
int =
D.map empty D.int
{-| Decode a JSON object into a list of pairs.
-}
keyValuePairs : Decoder a -> Decoder (List ( String, a ))
keyValuePairs x =
D.map
(\result ->
{ content = List.map (Tuple.mapSecond .content) result
, messages =
result
|> List.map Tuple.second
|> List.map .messages
|> List.concat
}
)
(D.keyValuePairs x)
{-| Sometimes you have JSON with recursive structure, like nested comments.
You can use `lazy` to make sure your decoder unrolls lazily.
-}
lazy : (() -> Decoder a) -> Decoder a
lazy =
D.lazy
{-| Decode a JSON array into an Elm list.
-}
list : Decoder a -> Decoder (List a)
list x =
D.map
(\result ->
{ content = List.map .content result
, messages =
result
|> List.map .messages
|> List.concat
}
)
(D.list x)
{-| Transform a decoder.
-}
map : (a -> value) -> Decoder a -> Decoder value
map func da =
D.map
(\a ->
{ content = func a.content
, messages = a.messages
}
)
da
{-| Try two decoders and combine the result.
-}
map2 : (a -> b -> value) -> Decoder a -> Decoder b -> Decoder value
map2 func da db =
D.map2
(\a b ->
{ content = func a.content b.content
, messages =
List.concat
[ a.messages
, b.messages
]
}
)
da
db
{-| Try three decoders and combine the result.
-}
map3 : (a -> b -> c -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder value
map3 func da db dc =
D.map3
(\a b c ->
{ content = func a.content b.content c.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
]
}
)
da
db
dc
{-| Try four decoders and combine the result.
-}
map4 : (a -> b -> c -> d -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder value
map4 func da db dc dd =
D.map4
(\a b c d ->
{ content = func a.content b.content c.content d.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
, d.messages
]
}
)
da
db
dc
dd
{-| Try five decoders and combine the result.
-}
map5 : (a -> b -> c -> d -> e -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder value
map5 func da db dc dd de =
D.map5
(\a b c d e ->
{ content = func a.content b.content c.content d.content e.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
, d.messages
, e.messages
]
}
)
da
db
dc
dd
de
{-| Try six decoders and combine the result.
-}
map6 : (a -> b -> c -> d -> e -> f -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder value
map6 func da db dc dd de df =
D.map6
(\a b c d e f ->
{ content = func a.content b.content c.content d.content e.content f.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
, d.messages
, e.messages
, f.messages
]
}
)
da
db
dc
dd
de
df
{-| Try seven decoders and combine the result.
-}
map7 : (a -> b -> c -> d -> e -> f -> g -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder g -> Decoder value
map7 func da db dc dd de df dg =
D.map7
(\a b c d e f g ->
{ content = func a.content b.content c.content d.content e.content f.content g.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
, d.messages
, e.messages
, f.messages
, g.messages
]
}
)
da
db
dc
dd
de
df
dg
{-| Try eight decoders and combine the result.
-}
map8 : (a -> b -> c -> d -> e -> f -> g -> h -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder g -> Decoder h -> Decoder value
map8 func da db dc dd de df dg dh =
D.map8
(\a b c d e f g h ->
{ content = func a.content b.content c.content d.content e.content f.content g.content h.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
, d.messages
, e.messages
, f.messages
, g.messages
, h.messages
]
}
)
da
db
dc
dd
de
df
dg
dh
{-| Try 9 decoders and combine the result.
-}
map9 :
(a -> b -> c -> d -> e -> f -> g -> h -> i -> value)
-> Decoder a
-> Decoder b
-> Decoder c
-> Decoder d
-> Decoder e
-> Decoder f
-> Decoder g
-> Decoder h
-> Decoder i
-> Decoder value
map9 func da db dc dd de df dg dh di =
D.map8
(\a b c d e f g ( h, i ) ->
{ content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
, d.messages
, e.messages
, f.messages
, g.messages
, h.messages
, i.messages
]
}
)
da
db
dc
dd
de
df
dg
(D.map2 Tuple.pair dh di)
{-| Try 10 decoders and combine the result.
-}
map10 :
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> value)
-> Decoder a
-> Decoder b
-> Decoder c
-> Decoder d
-> Decoder e
-> Decoder f
-> Decoder g
-> Decoder h
-> Decoder i
-> Decoder j
-> Decoder value
map10 func da db dc dd de df dg dh di dj =
D.map8
(\a b c d e f ( g, h ) ( i, j ) ->
{ content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content j.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
, d.messages
, e.messages
, f.messages
, g.messages
, h.messages
, i.messages
, j.messages
]
}
)
da
db
dc
dd
de
df
(D.map2 Tuple.pair dg dh)
(D.map2 Tuple.pair di dj)
{-| Try 11 decoders and combine the result.
-}
map11 :
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> value)
-> Decoder a
-> Decoder b
-> Decoder c
-> Decoder d
-> Decoder e
-> Decoder f
-> Decoder g
-> Decoder h
-> Decoder i
-> Decoder j
-> Decoder k
-> Decoder value
map11 func da db dc dd de df dg dh di dj dk =
D.map8
(\a b c d e ( f, g ) ( h, i ) ( j, k ) ->
{ content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content j.content k.content
, messages =
List.concat
[ a.messages
, b.messages
, c.messages
, d.messages
, e.messages
, f.messages
, g.messages
, h.messages
, i.messages
, j.messages
, k.messages
]
}
)
da
db
dc
dd
de
(D.map2 Tuple.pair df dg)
(D.map2 Tuple.pair dh di)
(D.map2 Tuple.pair dj dk)
{-| Helpful for dealing with optional fields
-}
maybe : Decoder a -> Decoder (Maybe a)
maybe x =
D.map
(\result ->
case result of
Just { content, messages } ->
{ content = Just content, messages = messages }
Nothing ->
empty Nothing
)
(D.maybe x)
{-| Decode a `null` value into some Elm value.
-}
null : a -> Decoder a
null =
D.null >> D.map empty
{-| Decode a nullable JSON value into an Elm value.
-}
nullable : Decoder a -> Decoder (Maybe a)
nullable x =
D.map
(\result ->
case result of
Just { content, messages } ->
{ content = Just content, messages = messages }
Nothing ->
empty Nothing
)
(D.nullable x)
{-| Try a bunch of different decoders. This can be useful if the JSON may come
in a couple different formats.
-}
oneOf : List (Decoder a) -> Decoder a
oneOf =
D.oneOf
{-| Decode a JSON object, requiring a particular field:
- If the field does not exist, the decoder decodes `Nothing`
- If the field DOES exist, the decoder must always return a `Just content` or fail
-}
opField : String -> Decoder a -> Decoder (Maybe a)
opField key x =
D.map
(\result ->
case result of
Just { content, messages } ->
{ content = Just content, messages = messages }
Nothing ->
empty Nothing
)
(D.opField key x)
{-| Decode a JSON object, requiring a particular field or raising a default:
- If the field does not exist, the decoder returns the default
- If the field DOES exist, the decoder must always return value or fail
-}
opFieldWithDefault : String -> a -> Decoder a -> Decoder a
opFieldWithDefault key default x =
opField key x |> map (Maybe.withDefault default)
{-| Transform a JSON boolean into a phantom Elm bool.
-}
pBool : Decoder Bool -> Decoder (Phantom.PBool ph)
pBool =
map Phantom.PBool
{-| Transform a JSON number into a phantom Elm int.
-}
pInt : Decoder Int -> Decoder (Phantom.PInt ph)
pInt =
map Phantom.PInt
{-| Transform a JSON list into a phantom Elm list.
-}
pList : Decoder (List a) -> Decoder (Phantom.PList ph a)
pList =
map Phantom.PList
{-| Transform a JSON string into a phantom Elm string.
-}
pString : Decoder String -> Decoder (Phantom.PString ph)
pString =
map Phantom.PString
{-| Decode a JSON object into an Elm dict.
-}
slowDict : Decoder a -> Decoder (SDict.Dict String a)
slowDict x =
D.map
(\result ->
{ content =
result
|> List.map (Tuple.mapSecond .content)
|> SDict.fromList
, messages =
result
|> List.map Tuple.second
|> List.map .messages
|> List.concat
}
)
(D.keyValuePairs x)
{-| Decode a JSON string into an Elm string.
This decoder also checks for suspicious inputs, such as the
[Leaking values](Internal-Config-Leaks), to look for suspicious inputs.
-}
string : Decoder String
string =
D.map
(\content ->
{ content = content
, messages =
if Set.member content L.allLeaks then
[ ( Log.securityWarn, Text.leakingValueFound content )
]
else
[]
}
)
D.string
{-| Ignore the JSON and produce a certain Elm value.
-}
succeed : a -> Decoder a
succeed =
D.succeed >> D.map empty
{-| Do not do anything with a JSON value, just bring it into Elm as a `Value`.
-}
value : Decoder D.Value
value =
D.map empty D.value

82
src/Internal/Tools/Hashdict.elm
View File

@ -4,7 +4,7 @@ module Internal.Tools.Hashdict exposing
, isEmpty, member, memberKey, get, size, isEqual
, keys, values, toList, fromList
, rehash, union
, encode, decoder, softDecoder
, coder, encode, decoder, softDecoder
)
{-| This module abstracts the `Dict` type with one function that assigns a
@ -40,13 +40,14 @@ This allows you to store values based on an externally defined identifier.
## JSON coders
@docs encode, decoder, softDecoder
@docs coder, encode, decoder, softDecoder
-}
import FastDict as Dict exposing (Dict)
import Json.Decode as D
import Json.Encode as E
import Internal.Config.Log as Log
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
{-| A dictionary of keys and values where each key is defined by its value. For
@ -80,25 +81,41 @@ type Hashdict a
}
coder : (a -> String) -> Json.Coder a -> Json.Coder (Hashdict a)
coder f c1 =
Json.andThen
{ name = Text.docs.hashdict.name
, description = Text.docs.hashdict.description
, forth =
-- TODO: Implement fastDictWithFilter function
\items ->
case List.filter (\( k, v ) -> f v /= k) (Dict.toList items) of
[] ->
{ hash = f, values = items }
|> Hashdict
|> Json.succeed
|> (|>) []
wrongHashes ->
wrongHashes
|> List.map Tuple.first
|> List.map ((++) "Invalid hash")
|> List.map Log.log.error
|> Json.fail Text.invalidHashInHashdict
, back = \(Hashdict h) -> h.values
, failure =
Text.failures.hashdict
}
(Json.fastDict c1)
{-| Decode a hashdict from a JSON value. To create a hashdict, you are expected
to insert a hash function. If the hash function doesn't properly hash the values
as expected, the decoder will fail to decode the hashdict.
-}
decoder : (a -> String) -> D.Decoder a -> D.Decoder (Hashdict a)
decoder f xDecoder =
D.keyValuePairs xDecoder
|> D.andThen
(\items ->
if List.all (\( hash, value ) -> f value == hash) items then
items
|> Dict.fromList
|> (\d -> { hash = f, values = d })
|> Hashdict
|> D.succeed
else
D.fail "Hash function fails to properly hash all values"
)
decoder : (a -> String) -> Json.Coder a -> Json.Decoder (Hashdict a)
decoder f c1 =
Json.decode (coder f c1)
{-| Create an empty hashdict.
@ -112,12 +129,9 @@ empty hash =
cannot be universally converted to JSON, so it is up to you to preserve that
hash function!
-}
encode : (a -> E.Value) -> Hashdict a -> E.Value
encode encodeX (Hashdict h) =
h.values
|> Dict.toList
|> List.map (Tuple.mapSecond encodeX)
|> E.object
encode : Json.Coder a -> Json.Encoder (Hashdict a)
encode c1 (Hashdict h) =
Json.encode (coder h.hash c1) (Hashdict h)
{-| Convert an association list into a hashdict.
@ -240,10 +254,20 @@ size (Hashdict h) =
used hash function, (or if you simply do not care) you can use this function to
decode and rehash the Hashdict using your new hash function.
-}
softDecoder : (a -> String) -> D.Decoder a -> D.Decoder (Hashdict a)
softDecoder f xDecoder =
D.keyValuePairs xDecoder
|> D.map (List.map Tuple.second >> fromList f)
softDecoder : (a -> String) -> Json.Coder a -> Json.Decoder (Hashdict a)
softDecoder f c1 =
c1
|> Json.fastDict
|> Json.map
{ name = Text.docs.hashdict.name
, description = Text.docs.hashdict.description
, forth =
\items ->
Hashdict { hash = f, values = items }
|> rehash f
, back = \(Hashdict h) -> h.values
}
|> Json.decode
{-| Convert a hashdict into an association list of key-value pairs, sorted by

178
src/Internal/Tools/Json.elm
View File

@ -1,10 +1,12 @@
module Internal.Tools.Json exposing
( Coder, string, bool, int, float
, encode, decode
( Coder, string, bool, int, float, value
, Encoder, encode, Decoder, decode, Value
, succeed, fail, andThen, lazy
, Docs(..), RequiredField(..), toDocs
, list, slowDict, fastDict, maybe
, Field, field
, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11
, map
)
{-|
@ -28,12 +30,17 @@ data types. Because this module uses dynamic builder types, this also means it
is relatively easy to write documentation for any data type that uses this
module to build its encoders and decoders.
@docs Coder, string, bool, int, float
@docs Coder, string, bool, int, float, value
## JSON Coding
@docs encode, decode
@docs Encoder, encode, Decoder, decode, Value
## Optional coding
@docs succeed, fail, andThen, lazy
## Documentation
@ -109,6 +116,22 @@ type Coder a
}
type DecodeResult a
= Success ( a, List Log )
| Fail ( String, List Log )
{-| Decoder type that describes the format of a JSON value that can be decoded
as a given type.
-}
type alias Decoder a =
D.Decoder ( a, List Log )
type alias Descriptive a =
{ a | name : String, description : List String }
{-| Structure of JSON documentation. It is up to an external module to turn the
documentation structure into a readable format.
-}
@ -117,11 +140,12 @@ type Docs
| DocsDict Docs
| DocsFloat
| DocsInt
| DocsLazy (() -> Docs)
| DocsList Docs
| DocsMap (Descriptive { content : Docs })
| DocsObject
{ name : String
, description : List String
, keys :
(Descriptive
{ keys :
List
{ field : String
, description : List String
@ -129,8 +153,17 @@ type Docs
, content : Docs
}
}
)
| DocsOptional Docs
| DocsRiskyMap (Descriptive { content : Docs, failure : List String })
| DocsString
| DocsValue
{-| Encoder type that takes an input and converts it to a JSON value.
-}
type alias Encoder a =
a -> E.Value
{-| Value that tells whether an object field is required to be included. If it
@ -143,6 +176,42 @@ type RequiredField
| OptionalFieldWithDefault String
type alias Value =
E.Value
{-| Continue decoding a result. This function tests if it meets the criteria,
and then it manages the results.
-}
andThen : Descriptive { back : b -> a, forth : a -> DecodeResult b, failure : List String } -> Coder a -> Coder b
andThen { name, description, failure, back, forth } (Coder old) =
Coder
{ encoder = back >> old.encoder
, decoder =
old.decoder
|> D.andThen
(\result ->
case result of
( out, logs ) ->
case forth out of
Success x ->
x
|> Tuple.mapSecond (List.append logs)
|> D.succeed
Fail ( f, _ ) ->
D.fail f
)
, docs =
DocsRiskyMap
{ name = name
, description = description
, content = old.docs
, failure = failure
}
}
{-| Define a boolean value.
-}
bool : Coder Bool
@ -190,14 +259,21 @@ encode (Coder data) =
data.encoder
{-| Fail a decoder.
-}
fail : String -> List Log -> DecodeResult a
fail reason logs =
Fail ( reason, logs )
{-| Define a fast dict. The dict can only have strings as keys.
-}
fastDict : Coder value -> Coder (FastDict.Dict String value)
fastDict (Coder value) =
fastDict (Coder old) =
Coder
{ encoder = FastDict.toCoreDict >> E.dict identity value.encoder
{ encoder = FastDict.toCoreDict >> E.dict identity old.encoder
, decoder =
value.decoder
old.decoder
|> D.keyValuePairs
|> D.map
(\items ->
@ -209,7 +285,7 @@ fastDict (Coder value) =
|> List.concatMap Tuple.second
)
)
, docs = DocsDict value.docs
, docs = DocsDict old.docs
}
@ -287,8 +363,8 @@ field =
decoder
|> D.opField fieldName
|> D.map
(\value ->
case value of
(\out ->
case out of
Just ( v, l ) ->
( Just v, l )
@ -341,6 +417,25 @@ int =
}
lazy : (() -> Coder value) -> Coder value
lazy f =
Coder
{ encoder =
\v ->
case f () of
Coder old ->
old.encoder v
, decoder =
D.lazy
(\() ->
case f () of
Coder old ->
old.decoder
)
, docs = DocsLazy (f >> toDocs)
}
{-| Define a list.
-}
list : Coder a -> Coder (List a)
@ -360,6 +455,23 @@ list (Coder old) =
}
{-| Map a value.
Given that the value needs to be both encoded and decoded, the map function
should be invertible.
-}
map : Descriptive { back : b -> a, forth : a -> b } -> Coder a -> Coder b
map { name, description, back, forth } (Coder old) =
Coder
{ encoder = back >> old.encoder
, decoder = D.map (Tuple.mapFirst forth) old.decoder
, docs =
DocsMap
{ name = name, description = description, content = old.docs }
}
{-| Define a maybe value.
NOTE: most of the time, you wish to avoid this function! Make sure to look at
@ -374,8 +486,8 @@ maybe (Coder old) =
old.decoder
|> D.nullable
|> D.map
(\value ->
case value of
(\out ->
case out of
Just ( v, logs ) ->
( Just v, logs )
@ -430,7 +542,7 @@ objectEncoder items object =
-}
object2 :
{ name : String, description : List String, init : a -> b -> object }
Descriptive { init : a -> b -> object }
-> Field a object
-> Field b object
-> Coder object
@ -465,7 +577,7 @@ object2 { name, description, init } fa fb =
{-| Define an object with 3 keys
-}
object3 :
{ name : String, description : List String, init : a -> b -> c -> object }
Descriptive { init : a -> b -> c -> object }
-> Field a object
-> Field b object
-> Field c object
@ -504,7 +616,7 @@ object3 { name, description, init } fa fb fc =
{-| Define an object with 4 keys
-}
object4 :
{ name : String, description : List String, init : a -> b -> c -> d -> object }
Descriptive { init : a -> b -> c -> d -> object }
-> Field a object
-> Field b object
-> Field c object
@ -547,7 +659,7 @@ object4 { name, description, init } fa fb fc fd =
{-| Define an object with 5 keys
-}
object5 :
{ name : String, description : List String, init : a -> b -> c -> d -> e -> object }
Descriptive { init : a -> b -> c -> d -> e -> object }
-> Field a object
-> Field b object
-> Field c object
@ -594,7 +706,7 @@ object5 { name, description, init } fa fb fc fd fe =
{-| Define an object with 6 keys
-}
object6 :
{ name : String, description : List String, init : a -> b -> c -> d -> e -> f -> object }
Descriptive { init : a -> b -> c -> d -> e -> f -> object }
-> Field a object
-> Field b object
-> Field c object
@ -645,7 +757,7 @@ object6 { name, description, init } fa fb fc fd fe ff =
{-| Define an object with 7 keys
-}
object7 :
{ name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> object }
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> object }
-> Field a object
-> Field b object
-> Field c object
@ -700,7 +812,7 @@ object7 { name, description, init } fa fb fc fd fe ff fg =
{-| Define an object with 8 keys
-}
object8 :
{ name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> object }
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> object }
-> Field a object
-> Field b object
-> Field c object
@ -759,7 +871,7 @@ object8 { name, description, init } fa fb fc fd fe ff fg fh =
{-| Define an object with 9 keys
-}
object9 :
{ name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> object }
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> object }
-> Field a object
-> Field b object
-> Field c object
@ -822,7 +934,7 @@ object9 { name, description, init } fa fb fc fd fe ff fg fh fi =
{-| Define an object with 10 keys
-}
object10 :
{ name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> object }
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> object }
-> Field a object
-> Field b object
-> Field c object
@ -889,7 +1001,7 @@ object10 { name, description, init } fa fb fc fd fe ff fg fh fi fj =
{-| Define an object with 11 keys
-}
object11 :
{ name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> object }
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> object }
-> Field a object
-> Field b object
-> Field c object
@ -991,6 +1103,13 @@ string =
}
{-| Succeed a decoder.
-}
succeed : a -> List Log -> DecodeResult a
succeed x logs =
Success ( x, logs )
{-| Turn a Field type into a usable JSON decoder
-}
toDecoderField : Field a object -> D.Decoder ( a, List Log )
@ -1016,3 +1135,12 @@ toDocsField x =
toEncodeField : Field a object -> ( String, object -> Maybe E.Value )
toEncodeField (Field data) =
( data.fieldName, data.toField >> data.encoder )
value : Coder Value
value =
Coder
{ encoder = identity
, decoder = D.map (\v -> ( v, [] )) D.value
, docs = DocsValue
}

80
src/Internal/Tools/Mashdict.elm
View File

@ -4,7 +4,7 @@ module Internal.Tools.Mashdict exposing
, isEmpty, member, memberKey, get, size, isEqual
, keys, values, toList, fromList
, rehash, union
, encode, decoder, softDecoder
, coder, encode, decoder, softDecoder
)
{-|
@ -48,13 +48,14 @@ In general, you are advised to learn more about the
## JSON coders
@docs encode, decoder, softDecoder
@docs coder, encode, decoder, softDecoder
-}
import FastDict as Dict exposing (Dict)
import Json.Decode as D
import Json.Encode as E
import Internal.Config.Log as Log
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
{-| A dictionary of keys and values where each key is defined by its value, but
@ -92,25 +93,39 @@ type Mashdict a
}
coder : (a -> Maybe String) -> Json.Coder a -> Json.Coder (Mashdict a)
coder f c1 =
Json.andThen
{ name = Text.docs.mashdict.name
, description = Text.docs.mashdict.description
, forth =
\items ->
case List.filter (\( k, v ) -> f v /= Just k) (Dict.toList items) of
[] ->
{ hash = f, values = items }
|> Mashdict
|> Json.succeed
|> (|>) []
wrongHashes ->
wrongHashes
|> List.map Tuple.first
|> List.map ((++) "Invalid hash")
|> List.map Log.log.error
|> Json.fail Text.invalidHashInMashdict
, back = \(Mashdict h) -> h.values
, failure = Text.failures.mashdict
}
(Json.fastDict c1)
{-| Decode a mashdict from a JSON value. To create a mashdict, you are expected
to insert a hash function. If the hash function doesn't properly hash the values
as expected, the decoder will fail to decode the mashdict.
-}
decoder : (a -> Maybe String) -> D.Decoder a -> D.Decoder (Mashdict a)
decoder f xDecoder =
D.keyValuePairs xDecoder
|> D.andThen
(\items ->
if List.all (\( hash, value ) -> f value == Just hash) items then
items
|> Dict.fromList
|> (\d -> { hash = f, values = d })
|> Mashdict
|> D.succeed
else
D.fail "Hash function fails to properly hash all values"
)
decoder : (a -> Maybe String) -> Json.Coder a -> Json.Decoder (Mashdict a)
decoder f c1 =
Json.decode (coder f c1)
{-| Create an empty mashdict.
@ -124,12 +139,9 @@ empty hash =
cannot be universally converted to JSON, so it is up to you to preserve that
hash function!
-}
encode : (a -> E.Value) -> Mashdict a -> E.Value
encode encodeX (Mashdict h) =
h.values
|> Dict.toList
|> List.map (Tuple.mapSecond encodeX)
|> E.object
encode : Json.Coder a -> Json.Encoder (Mashdict a)
encode c1 (Mashdict h) =
Json.encode (coder h.hash c1) (Mashdict h)
{-| Convert an association list into a mashdict.
@ -266,10 +278,20 @@ size (Mashdict h) =
used hash function, (or if you simply do not care) you can use this function to
decode and rehash the Mashdict using your new hash function.
-}
softDecoder : (a -> Maybe String) -> D.Decoder a -> D.Decoder (Mashdict a)
softDecoder f xDecoder =
D.keyValuePairs xDecoder
|> D.map (List.map Tuple.second >> fromList f)
softDecoder : (a -> Maybe String) -> Json.Coder a -> Json.Decoder (Mashdict a)
softDecoder f c1 =
c1
|> Json.fastDict
|> Json.map
{ name = Text.docs.hashdict.name
, description = Text.docs.hashdict.description
, forth =
\items ->
Mashdict { hash = f, values = items }
|> rehash f
, back = \(Mashdict h) -> h.values
}
|> Json.decode
{-| Convert a mashdict into an association list of key-value pairs, sorted by

30
src/Internal/Tools/Timestamp.elm
View File

@ -1,6 +1,6 @@
module Internal.Tools.Timestamp exposing
( Timestamp
, encode, decoder
, coder, encode, decoder
)
{-| The Timestamp module is a simplification of the Timestamp as delivered by
@ -14,12 +14,11 @@ elm/time. This module offers ways to work with the timestamp in meaningful ways.
## JSON coders
@docs encode, decoder
@docs coder, encode, decoder
-}
import Json.Decode as D
import Json.Encode as E
import Internal.Tools.Json as Json
import Time
@ -29,15 +28,30 @@ type alias Timestamp =
Time.Posix
{-| Create a Json coder
-}
coder : Json.Coder Timestamp
coder =
Json.map
{ back = Time.posixToMillis
, forth = Time.millisToPosix
, name = "Milliseconds to POSIX"
, description =
[ "Converts the timestamp from milliseconds to a POSIX timestamp."
]
}
Json.int
{-| Encode a timestamp into a JSON value.
-}
encode : Timestamp -> E.Value
encode : Json.Encoder Timestamp
encode =
Time.posixToMillis >> E.int
Json.encode coder
{-| Decode a timestamp from a JSON value.
-}
decoder : D.Decoder Timestamp
decoder : Json.Decoder Timestamp
decoder =
D.map Time.millisToPosix D.int
Json.decode coder

172
src/Internal/Values/Event.elm
View File

@ -1,7 +1,7 @@
module Internal.Values.Event exposing
( Event
, UnsignedData(..), age, prevContent, redactedBecause, transactionId
, encode, decoder
, coder, encode, decoder
)
{-|
@ -22,22 +22,20 @@ of a room.
## JSON Coder
@docs encode, decoder
@docs coder, encode, decoder
-}
import Internal.Config.Default as Default
import Internal.Tools.DecodeExtra as D
import Internal.Tools.EncodeExtra as E
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
import Json.Decode as D
import Json.Encode as E
{-| The Event type occurs everywhere on a user's timeline.
-}
type alias Event =
{ content : E.Value
{ content : Json.Value
, eventId : String
, originServerTs : Timestamp
, roomId : String
@ -54,7 +52,7 @@ helper functions.
type UnsignedData
= UnsignedData
{ age : Maybe Int
, prevContent : Maybe E.Value
, prevContent : Maybe Json.Value
, redactedBecause : Maybe Event
, transactionId : Maybe String
}
@ -67,66 +65,93 @@ age event =
Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned
coder : Json.Coder Event
coder =
Json.object8
{ name = Text.docs.event.name
, description = Text.docs.event.description
, init = Event
}
(Json.field.required
{ fieldName = "content"
, toField = .content
, description = Text.fields.event.content
, coder = Json.value
}
)
(Json.field.required
{ fieldName = "eventId"
, toField = .eventId
, description = Text.fields.event.eventId
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "originServerTs"
, toField = .originServerTs
, description = Text.fields.event.originServerTs
, coder = Timestamp.coder
}
)
(Json.field.required
{ fieldName = "roomId"
, toField = .roomId
, description = Text.fields.event.roomId
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "sender"
, toField = .sender
, description = Text.fields.event.sender
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "stateKey"
, toField = .stateKey
, description = Text.fields.event.stateKey
, coder = Json.string
}
)
(Json.field.required
-- NOTE! | In JSON we call it `type`, not `eventType`,
-- NOTE! | so that the data is easier to read for other non-Elm
-- NOTE! | JSON parsers
{ fieldName = "type"
, toField = .eventType
, description = Text.fields.event.eventType
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "unsigned"
, toField = .unsigned
, description = Text.fields.event.unsigned
, coder = unsignedCoder
}
)
{-| Decode an Event from a JSON value.
-}
decoder : D.Decoder Event
decoder : Json.Decoder Event
decoder =
D.map8 Event
(D.field "content" D.value)
(D.field "eventId" D.string)
(D.field "originServerTs" Timestamp.decoder)
(D.field "roomId" D.string)
(D.field "sender" D.string)
(D.opField "stateKey" D.string)
(D.field "eventType" D.string)
(D.opField "unsigned" decoderUnsignedData)
{-| Decode Unsigned Data from a JSON value.
-}
decoderUnsignedData : D.Decoder UnsignedData
decoderUnsignedData =
D.map4 (\a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d })
(D.opField "age" D.int)
(D.opField "prevContent" D.value)
(D.opField "redactedBecause" (D.lazy (\_ -> decoder)))
(D.opField "transactionId" D.string)
Json.decode coder
{-| Encode an Event into a JSON value.
-}
encode : Event -> E.Value
encode event =
E.maybeObject
[ ( "content", Just event.content )
, ( "eventId", Just <| E.string event.eventId )
, ( "originServerTs", Just <| Timestamp.encode event.originServerTs )
, ( "roomId", Just <| E.string event.roomId )
, ( "sender", Just <| E.string event.sender )
, ( "stateKey", Maybe.map E.string event.stateKey )
, ( "eventType", Just <| E.string event.eventType )
, ( "unsigned", Maybe.map encodeUnsignedData event.unsigned )
, ( "version", Just <| E.string Default.currentVersion )
]
{-| Encode Unsigned Data into a JSON value.
-}
encodeUnsignedData : UnsignedData -> E.Value
encodeUnsignedData (UnsignedData data) =
E.maybeObject
[ ( "age", Maybe.map E.int data.age )
, ( "prevContent", data.prevContent )
, ( "redactedBecause", Maybe.map encode data.redactedBecause )
, ( "transactionId", Maybe.map E.string data.transactionId )
]
encode : Json.Encoder Event
encode =
Json.encode coder
{-| Determine the previous `content` value for this event. This field is only a
`Just value` if the event is a state event, and the Matrix Vault has permission
to see the previous content.
-}
prevContent : Event -> Maybe E.Value
prevContent : Event -> Maybe Json.Value
prevContent event =
Maybe.andThen (\(UnsignedData data) -> data.prevContent) event.unsigned
@ -145,3 +170,40 @@ display the original transaction id used for the event.
transactionId : Event -> Maybe String
transactionId event =
Maybe.andThen (\(UnsignedData data) -> data.transactionId) event.unsigned
unsignedCoder : Json.Coder UnsignedData
unsignedCoder =
Json.object4
{ name = Text.docs.unsigned.name
, description = Text.docs.unsigned.description
, init = \a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d }
}
(Json.field.optional.value
{ fieldName = "age"
, toField = \(UnsignedData data) -> data.age
, description = Text.fields.unsigned.age
, coder = Json.int
}
)
(Json.field.optional.value
{ fieldName = "prevContent"
, toField = \(UnsignedData data) -> data.prevContent
, description = Text.fields.unsigned.prevContent
, coder = Json.value
}
)
(Json.field.optional.value
{ fieldName = "redactedBecause"
, toField = \(UnsignedData data) -> data.redactedBecause
, description = Text.fields.unsigned.redactedBecause
, coder = Json.lazy (\_ -> coder)
}
)
(Json.field.optional.value
{ fieldName = "transactionId"
, toField = \(UnsignedData data) -> data.transactionId
, description = Text.fields.unsigned.transactionId
, coder = Json.string
}
)

37
src/Internal/Values/StateManager.elm
View File

@ -3,7 +3,7 @@ module Internal.Values.StateManager exposing
, empty, singleton, insert, remove, append
, isEmpty, member, memberKey, get, size, isEqual
, keys, values, fromList, toList
, encode, decoder
, coder, encode, decoder
)
{-| The StateManager tracks the room state based on events, their event types
@ -34,15 +34,15 @@ dictionary-like experience to navigate through the Matrix room state.
## JSON coders
@docs encode, decoder
@docs coder, encode, decoder
-}
import FastDict as Dict exposing (Dict)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Tools.Mashdict as Mashdict exposing (Mashdict)
import Internal.Values.Event as Event exposing (Event)
import Json.Decode as D
import Json.Encode as E
{-| The StateManager manages the room state by gathering events and looking at
@ -93,15 +93,24 @@ cleanKey key (StateManager manager) =
|> StateManager
coder : Json.Coder StateManager
coder =
Event.coder
|> Mashdict.coder .stateKey
|> Json.fastDict
|> Json.map
{ name = Text.docs.stateManager.name
, description = Text.docs.stateManager.description
, forth = StateManager
, back = \(StateManager manager) -> manager
}
{-| Decode a StateManager from a JSON value.
-}
decoder : D.Decoder StateManager
decoder : Json.Decoder StateManager
decoder =
Event.decoder
|> Mashdict.decoder .stateKey
|> D.keyValuePairs
|> D.map Dict.fromList
|> D.map StateManager
Json.decode coder
{-| Create an empty StateManager.
@ -113,11 +122,9 @@ empty =
{-| Encode a StateManager into a JSON value.
-}
encode : StateManager -> E.Value
encode (StateManager manager) =
manager
|> Dict.toCoreDict
|> E.dict identity (Mashdict.encode Event.encode)
encode : Json.Encoder StateManager
encode =
Json.encode coder
{-| Build a StateManager using a list of events.

17
tests/Test/Tools/Hashdict.elm
View File

@ -3,6 +3,7 @@ module Test.Tools.Hashdict exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
import Internal.Tools.Json as Json
import Internal.Values.Event as Event
import Json.Decode as D
import Json.Encode as E
@ -93,11 +94,11 @@ suite =
"JSON encode -> JSON decode"
(\indent ->
Hashdict.empty identity
|> Hashdict.encode E.string
|> Json.encode (Hashdict.coder identity Json.string)
|> E.encode indent
|> D.decodeString (Hashdict.decoder identity D.string)
|> Result.map (Hashdict.isEqual (Hashdict.empty String.toUpper))
|> Expect.equal (Ok True)
|> D.decodeString (Json.decode <| Hashdict.coder identity Json.string)
|> Result.map (Tuple.mapFirst (Hashdict.isEqual (Hashdict.empty String.toUpper)))
|> Expect.equal (Ok ( True, [] ))
)
]
, describe "singleton"
@ -164,11 +165,11 @@ suite =
"JSON encode -> JSON decode"
(\hashdict indent ->
hashdict
|> Hashdict.encode Event.encode
|> Json.encode (Hashdict.coder .eventId Event.coder)
|> E.encode indent
|> D.decodeString (Hashdict.decoder .eventId Event.decoder)
|> Result.map Hashdict.toList
|> Expect.equal (Ok <| Hashdict.toList hashdict)
|> D.decodeString (Json.decode <| Hashdict.coder .eventId Event.coder)
|> Result.map (Tuple.mapFirst Hashdict.toList)
|> Expect.equal (Ok ( Hashdict.toList hashdict, [] ))
)
]
]

259
tests/Test/Tools/Json.elm
View File

@ -33,6 +33,50 @@ type alias Human5 =
}
type alias Human6 =
{ name : String
, age : Maybe Int
, hobbies : List String
, weight : Maybe Float
, height : Float
, invitedToParty : Bool
}
type alias Human7 =
{ name : String
, age : Maybe Int
, hobbies : List String
, weight : Maybe Float
, height : Float
, invitedToParty : Bool
, presentGiven : Maybe String
}
type alias Human8 =
{ name : String
, age : Maybe Int
, hobbies : List String
, weight : Maybe Float
, height : Float
, invitedToParty : Bool
, presentGiven : Maybe String
, grid : List (List Int)
}
type alias MegaHuman =
{ human2 : Human2
, human3 : Human3
, human4 : Human4
, human5 : Human5
, human6 : Human6
, human7 : Human7
, human8 : Human8
}
ageField : Json.Field (Maybe Int) { a | age : Maybe Int }
ageField =
Json.field.optional.value
@ -48,6 +92,23 @@ ageFuzzer =
Fuzz.maybe Fuzz.int
gridField : Json.Field (List (List Int)) { a | grid : List (List Int) }
gridField =
Json.field.optional.withDefault
{ fieldName = "grid"
, toField = .grid
, description = []
, coder = Json.list (Json.list Json.int)
, default = ( [], [] )
, defaultToString = always "[]"
}
gridFuzzer : Fuzzer (List (List Int))
gridFuzzer =
Fuzz.list (Fuzz.list Fuzz.int)
heightField : Json.Field Float { a | height : Float }
heightField =
Json.field.required
@ -80,6 +141,29 @@ hobbiesFuzzer =
Fuzz.list Fuzz.string
invitedToPartyField : Json.Field Bool { a | invitedToParty : Bool }
invitedToPartyField =
Json.field.optional.withDefault
{ fieldName = "invitedToParty"
, toField = .invitedToParty
, description = []
, coder = Json.bool
, default = ( False, [] )
, defaultToString =
\b ->
if b then
"True"
else
"False"
}
invitedToPartyFuzzer : Fuzzer Bool
invitedToPartyFuzzer =
Fuzz.bool
nameField : Json.Field String { a | name : String }
nameField =
Json.field.required
@ -95,6 +179,21 @@ nameFuzzer =
Fuzz.string
presentGivenField : Json.Field (Maybe String) { a | presentGiven : Maybe String }
presentGivenField =
Json.field.required
{ fieldName = "presentGiven"
, toField = .presentGiven
, description = []
, coder = Json.maybe Json.string
}
presentGivenFuzzer : Fuzzer (Maybe String)
presentGivenFuzzer =
Fuzz.maybe Fuzz.string
weightField : Json.Field (Maybe Float) { a | weight : Maybe Float }
weightField =
Json.field.optional.value
@ -195,6 +294,118 @@ human5Fuzzer =
heightFuzzer
human6Coder : Json.Coder Human6
human6Coder =
Json.object6
{ name = "Human6"
, description = []
, init = Human6
}
nameField
ageField
hobbiesField
weightField
heightField
invitedToPartyField
human6Fuzzer : Fuzzer Human6
human6Fuzzer =
Fuzz.map6 Human6
nameFuzzer
ageFuzzer
hobbiesFuzzer
weightFuzzer
heightFuzzer
invitedToPartyFuzzer
human7Coder : Json.Coder Human7
human7Coder =
Json.object7
{ name = "Human7"
, description = []
, init = Human7
}
nameField
ageField
hobbiesField
weightField
heightField
invitedToPartyField
presentGivenField
human7Fuzzer : Fuzzer Human7
human7Fuzzer =
Fuzz.map7 Human7
nameFuzzer
ageFuzzer
hobbiesFuzzer
weightFuzzer
heightFuzzer
invitedToPartyFuzzer
presentGivenFuzzer
human8Coder : Json.Coder Human8
human8Coder =
Json.object8
{ name = "Human8"
, description = []
, init = Human8
}
nameField
ageField
hobbiesField
weightField
heightField
invitedToPartyField
presentGivenField
gridField
human8Fuzzer : Fuzzer Human8
human8Fuzzer =
Fuzz.map8 Human8
nameFuzzer
ageFuzzer
hobbiesFuzzer
weightFuzzer
heightFuzzer
invitedToPartyFuzzer
presentGivenFuzzer
gridFuzzer
megaHumanCoder : Json.Coder MegaHuman
megaHumanCoder =
Json.object7
{ name = "MegaHuman"
, description = []
, init = MegaHuman
}
(Json.field.required { fieldName = "h2", toField = .human2, description = [], coder = human2Coder })
(Json.field.required { fieldName = "h3", toField = .human3, description = [], coder = human3Coder })
(Json.field.required { fieldName = "h4", toField = .human4, description = [], coder = human4Coder })
(Json.field.required { fieldName = "h5", toField = .human5, description = [], coder = human5Coder })
(Json.field.required { fieldName = "h6", toField = .human6, description = [], coder = human6Coder })
(Json.field.required { fieldName = "h7", toField = .human7, description = [], coder = human7Coder })
(Json.field.required { fieldName = "h8", toField = .human8, description = [], coder = human8Coder })
megahumanFuzzer : Fuzzer MegaHuman
megahumanFuzzer =
Fuzz.map7 MegaHuman
human2Fuzzer
human3Fuzzer
human4Fuzzer
human5Fuzzer
human6Fuzzer
human7Fuzzer
human8Fuzzer
suite : Test
suite =
describe "JSON module"
@ -246,4 +457,52 @@ suite =
|> Expect.equal (Ok human)
)
]
, describe "Human6"
[ fuzz human6Fuzzer
"Recoding succeeds"
(\human ->
human
|> Json.encode human6Coder
|> E.encode 0
|> D.decodeString (Json.decode human6Coder)
|> Result.map Tuple.first
|> Expect.equal (Ok human)
)
]
, describe "Human7"
[ fuzz human7Fuzzer
"Recoding succeeds"
(\human ->
human
|> Json.encode human7Coder
|> E.encode 0
|> D.decodeString (Json.decode human7Coder)
|> Result.map Tuple.first
|> Expect.equal (Ok human)
)
]
, describe "Human8"
[ fuzz human8Fuzzer
"Recoding succeeds"
(\human ->
human
|> Json.encode human8Coder
|> E.encode 0
|> D.decodeString (Json.decode human8Coder)
|> Result.map Tuple.first
|> Expect.equal (Ok human)
)
]
, describe "MegaHuman"
[ fuzz megahumanFuzzer
"Recoding succeeds"
(\megahuman ->
megahuman
|> Json.encode megaHumanCoder
|> E.encode 0
|> D.decodeString (Json.decode megaHumanCoder)
|> Result.map Tuple.first
|> Expect.equal (Ok megahuman)
)
]
]

17
tests/Test/Tools/Mashdict.elm
View File

@ -2,6 +2,7 @@ module Test.Tools.Mashdict exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Tools.Json as Json
import Internal.Tools.Mashdict as Mashdict exposing (Mashdict)
import Internal.Values.Event as Event
import Json.Decode as D
@ -93,11 +94,11 @@ suite =
"JSON encode -> JSON decode"
(\indent ->
Mashdict.empty Just
|> Mashdict.encode E.string
|> Json.encode (Mashdict.coder Just Json.string)
|> E.encode indent
|> D.decodeString (Mashdict.decoder Just D.string)
|> Result.map (Mashdict.isEqual (Mashdict.empty Just))
|> Expect.equal (Ok True)
|> D.decodeString (Json.decode <| Mashdict.coder Just Json.string)
|> Result.map (Tuple.mapFirst <| Mashdict.isEqual (Mashdict.empty Just))
|> Expect.equal (Ok ( True, [] ))
)
]
, describe "singleton"
@ -194,11 +195,11 @@ suite =
"JSON encode -> JSON decode"
(\hashdict indent ->
hashdict
|> Mashdict.encode Event.encode
|> Json.encode (Mashdict.coder .stateKey Event.coder)
|> E.encode indent
|> D.decodeString (Mashdict.decoder .stateKey Event.decoder)
|> Result.map Mashdict.toList
|> Expect.equal (Ok <| Mashdict.toList hashdict)
|> D.decodeString (Json.decode <| Mashdict.coder .stateKey Event.coder)
|> Result.map (Tuple.mapFirst Mashdict.toList)
|> Expect.equal (Ok ( Mashdict.toList hashdict, [] ))
)
]
]

4
tests/Test/Tools/Timestamp.elm
View File

@ -26,7 +26,7 @@ suite =
|> Timestamp.encode
|> E.encode indent
|> D.decodeString Timestamp.decoder
|> Expect.equal (Ok time)
|> Expect.equal (Ok ( time, [] ))
)
, fuzz fuzzer
"JSON decode -> millis"
@ -42,7 +42,7 @@ suite =
n
|> E.int
|> D.decodeValue Timestamp.decoder
|> Expect.equal (Ok <| Time.millisToPosix n)
|> Expect.equal (Ok ( Time.millisToPosix n, [] ))
)
]
, describe "Identity"

2
tests/Test/Values/StateManager.elm
View File

@ -84,7 +84,7 @@ suite =
|> StateManager.encode
|> E.encode 0
|> D.decodeString StateManager.decoder
|> Expect.equal (Ok StateManager.empty)
|> Expect.equal (Ok ( StateManager.empty, [] ))
|> always
)
]