mirror of
https://github.com/ilyakooo0/airlock.git
synced 2024-10-03 21:37:36 +03:00
Simplified deconstructors (#11)
This commit is contained in:
GitHub
parent
0b17a24d29
commit
4d7d7b06af
@ -14,7 +14,6 @@ import Ur.Constructor as C
|
||||
import Ur.Deconstructor as D
|
||||
import Ur.Run
|
||||
import Ur.Sub
|
||||
import Ur.Types exposing (Noun)
|
||||
import Widget
|
||||
import Widget.Icon as Icon
|
||||
import Widget.Material as Material
|
||||
@ -56,7 +55,7 @@ main =
|
||||
, app = "journal"
|
||||
, path = [ "sync" ]
|
||||
, deconstructor =
|
||||
D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b )))
|
||||
D.list (D.cell D.bigint D.cord)
|
||||
|> D.map GotListings
|
||||
}
|
||||
]
|
||||
|
||||
@ -46,9 +46,9 @@ main =
|
||||
, success =
|
||||
D.cell D.ignore
|
||||
(D.cell (D.const D.cord "jrnl")
|
||||
(D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b ))))
|
||||
|> D.map GotListings
|
||||
(D.list (D.cell D.bigint D.cord))
|
||||
)
|
||||
|> D.map (\( (), ( (), listings ) ) -> GotListings listings)
|
||||
}
|
||||
]
|
||||
|> Ur.Cmd.cmd
|
||||
@ -177,14 +177,15 @@ type JournalUpdate
|
||||
| Delete BigInt
|
||||
|
||||
|
||||
decodeJournalUpdate : D.Deconstructor (JournalUpdate -> a) a
|
||||
decodeJournalUpdate : D.Deconstructor JournalUpdate
|
||||
decodeJournalUpdate =
|
||||
D.cell D.ignore <|
|
||||
D.oneOf
|
||||
[ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map Add
|
||||
, (D.cell (D.const D.cord "edit") <| D.cell D.bigint D.cord) |> D.map Edit
|
||||
, D.cell (D.const D.cord "del") D.bigint |> D.map Delete
|
||||
]
|
||||
D.oneOf
|
||||
[ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map (\( (), ( id, txt ) ) -> Add id txt)
|
||||
, D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
|
||||
, D.cell (D.const D.cord "del") D.bigint |> D.map (\( (), id ) -> Delete id)
|
||||
]
|
||||
|> D.cell D.ignore
|
||||
|> D.map (\( (), upd ) -> upd)
|
||||
|
||||
|
||||
view : Model -> Document Msg
|
||||
|
||||
@ -77,7 +77,7 @@ scry :
|
||||
, agent : Agent
|
||||
, path : Path
|
||||
, error : msg
|
||||
, success : D.Deconstructor (msg -> msg) msg
|
||||
, success : D.Deconstructor msg
|
||||
}
|
||||
-> Cmd msg
|
||||
scry args =
|
||||
@ -91,7 +91,7 @@ scryTask :
|
||||
, agent : Agent
|
||||
, path : Path
|
||||
, error : msg
|
||||
, success : D.Deconstructor (msg -> msg) msg
|
||||
, success : D.Deconstructor msg
|
||||
}
|
||||
-> Task a msg
|
||||
scryTask { url, agent, path, error, success } =
|
||||
|
||||
@ -11,19 +11,11 @@ module Ur.Deconstructor exposing
|
||||
|
||||
{-| This module provides an API to deconstruct `Noun`s into arbitrary Elm data structures.
|
||||
|
||||
The principal (and types) are very similar to `Url.Parser` from `elm/url`.
|
||||
|
||||
You would parse a `[%edit @ cord]` like this:
|
||||
|
||||
type alias Edit = {id: Int, text : String}
|
||||
|
||||
(D.cell (D.const D.cord "edit") (D.cell D.int D.cord)) |> D.map Edit
|
||||
|
||||
When you `map` a `Deconstructor` the function you pass to `map` will accept exactly the number of arguments
|
||||
that "captured" values in exacly the order they occured in the `Deconstructor`.
|
||||
|
||||
In our case we `map` the `Edit` type, which accepts exaclty two arguments because there are two `Deconstructor`s
|
||||
that "capture" a value: `D.int` and `D.cord`.
|
||||
(D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord)) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
|
||||
|
||||
@docs Deconstructor
|
||||
|
||||
@ -80,27 +72,25 @@ import Ur.Types exposing (..)
|
||||
|
||||
{-| A `Noun` deconstructor.
|
||||
-}
|
||||
type Deconstructor a b
|
||||
= Deconstructor (Noun -> a -> Maybe b)
|
||||
type alias Deconstructor a =
|
||||
Noun -> Maybe a
|
||||
|
||||
|
||||
{-| Executes a `Deconstructor` on a `Noun`.
|
||||
-}
|
||||
run : Deconstructor (a -> a) a -> Noun -> Maybe a
|
||||
run (Deconstructor f) noun =
|
||||
f noun identity
|
||||
run : Deconstructor a -> Noun -> Maybe a
|
||||
run f noun =
|
||||
f noun
|
||||
|
||||
|
||||
{-| Executes a deconstructor on a `jam`med `Noun`.
|
||||
-}
|
||||
runBytes : Deconstructor (a -> a) a -> Bytes -> Maybe a
|
||||
runBytes (Deconstructor f) bs =
|
||||
cue bs
|
||||
|> Maybe.andThen
|
||||
(\noun -> f noun identity)
|
||||
runBytes : Deconstructor a -> Bytes -> Maybe a
|
||||
runBytes f bs =
|
||||
cue bs |> Maybe.andThen f
|
||||
|
||||
|
||||
{-| Asserts that the value at the current position should be exactly equal to the second argument.
|
||||
{-| Asserts that the value should be exactly equal to the second argument.
|
||||
|
||||
The first argument is a `Deconstructor` for the given type.
|
||||
|
||||
@ -109,104 +99,39 @@ The second argument is the value to compare with.
|
||||
This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.
|
||||
|
||||
-}
|
||||
const : Deconstructor (a -> a) a -> a -> Deconstructor c c
|
||||
const (Deconstructor f) value =
|
||||
Deconstructor
|
||||
(\noun c ->
|
||||
case f noun identity of
|
||||
Just a ->
|
||||
if a == value then
|
||||
Just c
|
||||
const : Deconstructor a -> a -> Deconstructor ()
|
||||
const f value noun =
|
||||
case f noun of
|
||||
Just a ->
|
||||
if a == value then
|
||||
Just ()
|
||||
|
||||
else
|
||||
Nothing
|
||||
else
|
||||
Nothing
|
||||
|
||||
Nothing ->
|
||||
Nothing
|
||||
)
|
||||
Nothing ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Extracts a `cord` at the current location.
|
||||
-}
|
||||
cord : Deconstructor (String -> a) a
|
||||
cord =
|
||||
Deconstructor
|
||||
(\x f ->
|
||||
case x of
|
||||
Atom bs ->
|
||||
BD.decode (BD.string (Bytes.width bs)) bs
|
||||
|> Maybe.map f
|
||||
bigint : Deconstructor BigInt
|
||||
bigint x =
|
||||
case x of
|
||||
Atom bs ->
|
||||
BigInt.Bytes.decode bs |> Just
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
)
|
||||
Cell _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Extracts a `tape` at the current location.
|
||||
-}
|
||||
tape : Deconstructor (String -> a) a
|
||||
tape =
|
||||
list cord |> fmap String.concat
|
||||
{-| Extracts a 32-bit signed `Int`.
|
||||
|
||||
|
||||
{-| Extracts a 32-bit unsigned `Int` at the given location.
|
||||
|
||||
If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.
|
||||
If the `Atom` is larger than 32 bits the the behaviour is undefined.
|
||||
|
||||
-}
|
||||
int : Deconstructor (Int -> a) a
|
||||
int =
|
||||
Deconstructor
|
||||
(\x f ->
|
||||
case x of
|
||||
Atom bs ->
|
||||
(case Bytes.width bs of
|
||||
1 ->
|
||||
BD.decode BD.unsignedInt8 bs
|
||||
|
||||
2 ->
|
||||
BD.decode (BD.unsignedInt16 LE) bs
|
||||
|
||||
3 ->
|
||||
BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
|
||||
|
||||
4 ->
|
||||
BD.decode (BD.unsignedInt32 LE) bs
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
)
|
||||
|> Maybe.map f
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
)
|
||||
|
||||
|
||||
{-| Extracts a `BigInt` at the current location.
|
||||
-}
|
||||
bigint : Deconstructor (BigInt -> a) a
|
||||
bigint =
|
||||
Deconstructor
|
||||
(\x f ->
|
||||
case x of
|
||||
Atom bs ->
|
||||
BigInt.Bytes.decode bs |> f |> Just
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
)
|
||||
|
||||
|
||||
{-| Extracts a 32-bit signed `Int` at the given location.
|
||||
|
||||
If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.
|
||||
|
||||
-}
|
||||
signedInt : Deconstructor (Int -> a) a
|
||||
signedInt : Deconstructor Int
|
||||
signedInt =
|
||||
int
|
||||
|> fmap
|
||||
|> map
|
||||
(\i ->
|
||||
if Bitwise.and 1 i == 1 then
|
||||
-(Bitwise.shiftRightBy 1 (1 + i))
|
||||
@ -216,105 +141,85 @@ signedInt =
|
||||
)
|
||||
|
||||
|
||||
{-| Extracts a 32-bit `Float` at the given location.
|
||||
{-| Extracts a 32-bit `Float`.
|
||||
-}
|
||||
float32 : Deconstructor (Float -> a) a
|
||||
float32 =
|
||||
Deconstructor
|
||||
(\x f ->
|
||||
case x of
|
||||
Atom bs ->
|
||||
BD.decode (BD.float32 LE) bs
|
||||
|> Maybe.map f
|
||||
float32 : Deconstructor Float
|
||||
float32 x =
|
||||
case x of
|
||||
Atom bs ->
|
||||
BD.decode (BD.float32 LE) bs
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
)
|
||||
Cell _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Extracts a 64-bit `Float` at the given location.
|
||||
{-| Extracts a 64-bit `Float`.
|
||||
-}
|
||||
float64 : Deconstructor (Float -> a) a
|
||||
float64 =
|
||||
Deconstructor
|
||||
(\x f ->
|
||||
case x of
|
||||
Atom bs ->
|
||||
BD.decode (BD.float64 LE) bs
|
||||
|> Maybe.map f
|
||||
float64 : Deconstructor Float
|
||||
float64 x =
|
||||
case x of
|
||||
Atom bs ->
|
||||
BD.decode (BD.float64 LE) bs
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
)
|
||||
Cell _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Extracts the raw `Byte`s of an `Atom` at the current location.
|
||||
{-| Extracts the raw `Byte`s of an `Atom`.
|
||||
-}
|
||||
bytes : Deconstructor (Bytes -> a) a
|
||||
bytes =
|
||||
Deconstructor
|
||||
(\n f ->
|
||||
case n of
|
||||
Atom bs ->
|
||||
f bs |> Just
|
||||
bytes : Deconstructor Bytes
|
||||
bytes n =
|
||||
case n of
|
||||
Atom bs ->
|
||||
Just bs
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
)
|
||||
Cell _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Asserts the the `Atom` at the current position should be exactly `sig` (`~`).
|
||||
{-| Asserts the the `Atom` should be exactly `sig` (`~`).
|
||||
-}
|
||||
sig : Deconstructor a a
|
||||
sig =
|
||||
Deconstructor
|
||||
(\n a ->
|
||||
case n of
|
||||
Atom b ->
|
||||
if (Bytes.Extra.toByteValues b |> List.filter (\x -> x /= 0)) == [] then
|
||||
Just a
|
||||
sig : Deconstructor ()
|
||||
sig n =
|
||||
case n of
|
||||
Atom b ->
|
||||
if (Bytes.Extra.toByteValues b |> List.filter (\x -> x /= 0)) == [] then
|
||||
Just ()
|
||||
|
||||
else
|
||||
Nothing
|
||||
else
|
||||
Nothing
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
)
|
||||
Cell _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Extracts a sig-terminated list of arbitrary elements at the current position.
|
||||
{-| Extracts a sig-terminated list of arbitrary elements.
|
||||
|
||||
The first argument is a `Deconstructor` of the elements of the list.
|
||||
|
||||
-}
|
||||
list : Deconstructor (a -> a) a -> Deconstructor (List a -> b) b
|
||||
list (Deconstructor f) =
|
||||
Deconstructor
|
||||
(\n g ->
|
||||
let
|
||||
go n_ =
|
||||
case n_ of
|
||||
Atom _ ->
|
||||
Just []
|
||||
list : Deconstructor a -> Deconstructor (List a)
|
||||
list f n =
|
||||
let
|
||||
go n_ =
|
||||
case n_ of
|
||||
Atom _ ->
|
||||
Just []
|
||||
|
||||
Cell ( el, tail ) ->
|
||||
Maybe.map2 (\a b -> a :: b) (f el identity) (go tail)
|
||||
in
|
||||
go n |> Maybe.map g
|
||||
)
|
||||
Cell ( el, tail ) ->
|
||||
Maybe.map2 (\a b -> a :: b) (f el) (go tail)
|
||||
in
|
||||
go n
|
||||
|
||||
|
||||
alt : Deconstructor a b -> Deconstructor a b -> Deconstructor a b
|
||||
alt (Deconstructor f) (Deconstructor g) =
|
||||
Deconstructor
|
||||
(\n a ->
|
||||
case f n a of
|
||||
Just x ->
|
||||
Just x
|
||||
alt : Deconstructor a -> Deconstructor a -> Deconstructor a
|
||||
alt f g n =
|
||||
case f n of
|
||||
Just x ->
|
||||
Just x
|
||||
|
||||
Nothing ->
|
||||
g n a
|
||||
)
|
||||
Nothing ->
|
||||
g n
|
||||
|
||||
|
||||
{-| Try to execute all of the `Deconstructor`s in order until one succeeds.
|
||||
@ -322,34 +227,24 @@ alt (Deconstructor f) (Deconstructor g) =
|
||||
This is especially useful for deconstructing head-tagged unions from Hoon.
|
||||
|
||||
-}
|
||||
oneOf : List (Deconstructor a b) -> Deconstructor a b
|
||||
oneOf : List (Deconstructor a) -> Deconstructor a
|
||||
oneOf l =
|
||||
case l of
|
||||
[] ->
|
||||
Deconstructor (\_ _ -> Nothing)
|
||||
always Nothing
|
||||
|
||||
x :: xs ->
|
||||
alt x (oneOf xs)
|
||||
|
||||
|
||||
{-| Extract the raw `Noun` at the current position.
|
||||
|
||||
Always succeeds.
|
||||
|
||||
-}
|
||||
tar : Deconstructor (Noun -> a) a
|
||||
tar =
|
||||
Deconstructor (\noun f -> Just (f noun))
|
||||
|
||||
|
||||
{-| Ignore any value at the current position.
|
||||
{-| Ignore any value.
|
||||
|
||||
This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
|
||||
|
||||
-}
|
||||
ignore : Deconstructor a a
|
||||
ignore : Deconstructor ()
|
||||
ignore =
|
||||
Deconstructor (\_ f -> Just f)
|
||||
always (Just ())
|
||||
|
||||
|
||||
{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
|
||||
@ -357,30 +252,14 @@ ignore =
|
||||
Accepts two arbitrary `Deconstructor`s that form a Cell.
|
||||
|
||||
-}
|
||||
cell : Deconstructor a b -> Deconstructor b c -> Deconstructor a c
|
||||
cell (Deconstructor l) (Deconstructor r) =
|
||||
Deconstructor
|
||||
(\noun a ->
|
||||
case noun of
|
||||
Cell ( lhs, rhs ) ->
|
||||
l lhs a |> Maybe.andThen (\b -> r rhs b)
|
||||
cell : Deconstructor a -> Deconstructor b -> Deconstructor ( a, b )
|
||||
cell l r noun =
|
||||
case noun of
|
||||
Cell ( lhs, rhs ) ->
|
||||
l lhs |> Maybe.andThen (\a -> r rhs |> Maybe.map (\b -> ( a, b )))
|
||||
|
||||
Atom _ ->
|
||||
Nothing
|
||||
)
|
||||
|
||||
|
||||
{-| "Lazily" applies a deconstructor.
|
||||
This is useful when you are defining a recursive `Deconstructor` which needs to call itself.
|
||||
-}
|
||||
lazy : (() -> Deconstructor a b) -> Deconstructor a b
|
||||
lazy f =
|
||||
Deconstructor
|
||||
(\noun a ->
|
||||
case f () of
|
||||
Deconstructor g ->
|
||||
g noun a
|
||||
)
|
||||
Atom _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Maps (applies) a function to all of the values deconstructed.
|
||||
@ -388,11 +267,69 @@ lazy f =
|
||||
This is useful when you want to create a data type with extracted values as fields.
|
||||
|
||||
-}
|
||||
map : a -> Deconstructor a b -> Deconstructor (b -> c) c
|
||||
map a (Deconstructor f) =
|
||||
Deconstructor (\noun g -> f noun a |> Maybe.map g)
|
||||
lazy : (() -> Deconstructor a) -> Deconstructor a
|
||||
lazy f noun =
|
||||
f () noun
|
||||
|
||||
|
||||
fmap : (a -> b) -> Deconstructor (a -> c) c -> Deconstructor (b -> c) c
|
||||
fmap f (Deconstructor g) =
|
||||
Deconstructor (\noun h -> g noun (f >> h))
|
||||
map : (a -> b) -> Deconstructor a -> Deconstructor b
|
||||
map g f noun =
|
||||
f noun |> Maybe.map g
|
||||
|
||||
|
||||
{-| Extracts a `cord`.
|
||||
-}
|
||||
cord : Deconstructor String
|
||||
cord x =
|
||||
case x of
|
||||
Atom bs ->
|
||||
BD.decode (BD.string (Bytes.width bs)) bs
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Extracts a `tape`.
|
||||
-}
|
||||
tape : Deconstructor String
|
||||
tape =
|
||||
list cord |> map String.concat
|
||||
|
||||
|
||||
{-| Extracts a 32-bit unsigned `Int`.
|
||||
|
||||
If the `Atom` is larger than 32 bits the the behaviour is undefined.
|
||||
|
||||
-}
|
||||
int : Deconstructor Int
|
||||
int x =
|
||||
case x of
|
||||
Atom bs ->
|
||||
case Bytes.width bs of
|
||||
1 ->
|
||||
BD.decode BD.unsignedInt8 bs
|
||||
|
||||
2 ->
|
||||
BD.decode (BD.unsignedInt16 LE) bs
|
||||
|
||||
3 ->
|
||||
BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
|
||||
|
||||
4 ->
|
||||
BD.decode (BD.unsignedInt32 LE) bs
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
|
||||
Cell _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Extract the raw `Noun`.
|
||||
|
||||
Always succeeds.
|
||||
|
||||
-}
|
||||
tar : Deconstructor Noun
|
||||
tar =
|
||||
Just
|
||||
|
||||
@ -11,29 +11,17 @@ type Patch
|
||||
| Diff DelDiff InsDiff
|
||||
|
||||
|
||||
deconstructPatch : D.Deconstructor (Patch -> c) c
|
||||
deconstructPatch =
|
||||
deconstructPatch : () -> D.Deconstructor Patch
|
||||
deconstructPatch () =
|
||||
D.oneOf
|
||||
[ D.cell (D.const D.cord "cell")
|
||||
(D.cell
|
||||
(D.lazy (\() -> deconstructPatch_))
|
||||
(D.lazy (\() -> deconstructPatch_))
|
||||
(D.lazy deconstructPatch)
|
||||
(D.lazy deconstructPatch)
|
||||
)
|
||||
|> D.map PatchCell
|
||||
, D.cell (D.const D.cord "diff") (D.cell deconstructDel deconstructIns) |> D.map Diff
|
||||
]
|
||||
|
||||
|
||||
deconstructPatch_ : D.Deconstructor (Patch -> c) c
|
||||
deconstructPatch_ =
|
||||
D.oneOf
|
||||
[ D.cell (D.const D.cord "cell")
|
||||
(D.cell
|
||||
deconstructPatch
|
||||
deconstructPatch
|
||||
)
|
||||
|> D.map PatchCell
|
||||
, D.cell (D.const D.cord "diff") (D.cell deconstructDel deconstructIns) |> D.map Diff
|
||||
|> D.map (\( (), ( a, b ) ) -> PatchCell a b)
|
||||
, D.cell (D.const D.cord "diff") (D.cell (D.lazy deconstructDel) (D.lazy deconstructIns))
|
||||
|> D.map (\( (), ( a, b ) ) -> Diff a b)
|
||||
]
|
||||
|
||||
|
||||
@ -93,31 +81,17 @@ type DelDiff
|
||||
| DelCell DelDiff DelDiff
|
||||
|
||||
|
||||
deconstructDel : D.Deconstructor (DelDiff -> c) c
|
||||
deconstructDel =
|
||||
deconstructDel : () -> D.Deconstructor DelDiff
|
||||
deconstructDel () =
|
||||
D.oneOf
|
||||
[ D.cell (D.const D.cord "ignore") D.ignore |> D.map Ignore
|
||||
, D.cell (D.const D.cord "hole") D.int |> D.map DelHole
|
||||
[ D.cell (D.const D.cord "ignore") D.ignore |> D.map (\( (), () ) -> Ignore)
|
||||
, D.cell (D.const D.cord "hole") D.int |> D.map (\( (), x ) -> DelHole x)
|
||||
, D.cell (D.const D.cord "cell")
|
||||
(D.cell
|
||||
deconstructDel_
|
||||
deconstructDel_
|
||||
(D.lazy deconstructDel)
|
||||
(D.lazy deconstructDel)
|
||||
)
|
||||
|> D.map DelCell
|
||||
]
|
||||
|
||||
|
||||
deconstructDel_ : D.Deconstructor (DelDiff -> c) c
|
||||
deconstructDel_ =
|
||||
D.oneOf
|
||||
[ D.const D.cord "ignore" |> D.map Ignore
|
||||
, D.cell (D.const D.cord "hole") D.int |> D.map DelHole
|
||||
, D.cell (D.const D.cord "cell")
|
||||
(D.cell
|
||||
(D.lazy (\() -> deconstructDel))
|
||||
(D.lazy (\() -> deconstructDel))
|
||||
)
|
||||
|> D.map DelCell
|
||||
|> D.map (\( (), ( lhs, rhs ) ) -> DelCell lhs rhs)
|
||||
]
|
||||
|
||||
|
||||
@ -127,29 +101,15 @@ type InsDiff
|
||||
| InsCell InsDiff InsDiff
|
||||
|
||||
|
||||
deconstructIns : D.Deconstructor (InsDiff -> c) c
|
||||
deconstructIns =
|
||||
deconstructIns : () -> D.Deconstructor InsDiff
|
||||
deconstructIns () =
|
||||
D.oneOf
|
||||
[ D.cell (D.const D.cord "hole") D.int |> D.map InsHole
|
||||
, D.cell (D.const D.cord "atom") D.bytes |> D.map InsAtom
|
||||
[ D.cell (D.const D.cord "hole") D.int |> D.map (\( (), x ) -> InsHole x)
|
||||
, D.cell (D.const D.cord "atom") D.bytes |> D.map (\( (), bs ) -> InsAtom bs)
|
||||
, D.cell (D.const D.cord "cell")
|
||||
(D.cell
|
||||
deconstructIns_
|
||||
deconstructIns_
|
||||
(D.lazy deconstructIns)
|
||||
(D.lazy deconstructIns)
|
||||
)
|
||||
|> D.map InsCell
|
||||
]
|
||||
|
||||
|
||||
deconstructIns_ : D.Deconstructor (InsDiff -> c) c
|
||||
deconstructIns_ =
|
||||
D.oneOf
|
||||
[ D.cell (D.const D.cord "hole") D.int |> D.map InsHole
|
||||
, D.cell (D.const D.cord "atom") D.bytes |> D.map InsAtom
|
||||
, D.cell (D.const D.cord "cell")
|
||||
(D.cell
|
||||
(D.lazy (\() -> deconstructIns))
|
||||
(D.lazy (\() -> deconstructIns))
|
||||
)
|
||||
|> D.map InsCell
|
||||
|> D.map (\( (), ( a, b ) ) -> InsCell a b)
|
||||
]
|
||||
|
||||
@ -31,7 +31,7 @@ type alias SubDict msg =
|
||||
Dict
|
||||
-- (ship, agent, path)
|
||||
( String, String, List String )
|
||||
{ deconstructor : D.Deconstructor (msg -> msg) msg
|
||||
{ deconstructor : D.Deconstructor msg
|
||||
, number : Int
|
||||
, sink : Bool
|
||||
}
|
||||
@ -211,12 +211,10 @@ update inp msg model =
|
||||
Ok string ->
|
||||
case
|
||||
D.runBytes
|
||||
(D.cell D.int (D.cell D.cord D.tar)
|
||||
|> D.map (\a b c -> ( a, b, c ))
|
||||
)
|
||||
(D.cell D.int (D.cell D.cord D.tar))
|
||||
(Ur.Uw.decode string)
|
||||
of
|
||||
Just ( messageId, messageType, rest ) ->
|
||||
Just ( messageId, ( messageType, rest ) ) ->
|
||||
let
|
||||
( eventId, ackReqs ) =
|
||||
tag model.eventId [ Ack messageId ]
|
||||
@ -248,7 +246,7 @@ update inp msg model =
|
||||
of
|
||||
Just { deconstructor, sink } ->
|
||||
if sink then
|
||||
case D.run (D.cell D.ignore (D.cell D.ignore deconstructSink)) rest of
|
||||
case D.run (D.cell D.ignore (D.cell D.ignore deconstructSink) |> D.map (\( (), ( (), s ) ) -> s)) rest of
|
||||
Just (Flush noun) ->
|
||||
( { model | sinks = Dict.insert messageId noun model.sinks }
|
||||
, case D.run deconstructor noun of
|
||||
@ -284,7 +282,7 @@ update inp msg model =
|
||||
( model, Cmd.none )
|
||||
|
||||
else
|
||||
case D.run (D.cell D.ignore (D.cell D.ignore deconstructor)) rest of
|
||||
case D.run (D.cell D.ignore (D.cell D.ignore deconstructor) |> D.map (\((), ((), m)) -> m)) rest of
|
||||
Just subMsg ->
|
||||
( model_, pureCmd (AppMsg subMsg) )
|
||||
|
||||
@ -351,11 +349,11 @@ type Sink
|
||||
| Drain Patch
|
||||
|
||||
|
||||
deconstructSink : D.Deconstructor (Sink -> c) c
|
||||
deconstructSink : D.Deconstructor Sink
|
||||
deconstructSink =
|
||||
D.oneOf
|
||||
[ D.cell (D.const D.cord "flush") D.tar |> D.map Flush
|
||||
, D.cell (D.const D.cord "drain") deconstructPatch |> D.map Drain
|
||||
[ D.cell (D.const D.cord "flush") D.tar |> D.map (\( (), n ) -> Flush n)
|
||||
, D.cell (D.const D.cord "drain") (D.lazy deconstructPatch) |> D.map (\( (), patch ) -> Drain patch)
|
||||
]
|
||||
|
||||
|
||||
|
||||
@ -30,7 +30,7 @@ type alias Sub msg =
|
||||
}
|
||||
|
||||
-}
|
||||
subscribe : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor (msg -> msg) msg } -> Sub msg
|
||||
subscribe : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor msg } -> Sub msg
|
||||
subscribe { ship, app, path, deconstructor } =
|
||||
Dict.singleton ( ship, app, path )
|
||||
{ deconstructor = deconstructor
|
||||
@ -41,7 +41,7 @@ subscribe { ship, app, path, deconstructor } =
|
||||
|
||||
{-| Creates a %sink subscription.
|
||||
-}
|
||||
sink : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor (msg -> msg) msg } -> Sub msg
|
||||
sink : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor msg } -> Sub msg
|
||||
sink { ship, app, path, deconstructor } =
|
||||
Dict.singleton ( ship, app, path )
|
||||
{ deconstructor = deconstructor
|
||||
|
||||
@ -10,7 +10,7 @@ type Sub msg
|
||||
(Dict
|
||||
-- key is (ship, app, path)
|
||||
( Ship, Agent, Path )
|
||||
{ deconstructor : D.Deconstructor (msg -> msg) msg
|
||||
{ deconstructor : D.Deconstructor msg
|
||||
, sink : Bool
|
||||
}
|
||||
)
|
||||
|
||||
@ -77,7 +77,7 @@ tests =
|
||||
Expect.equal
|
||||
(Just ( 1, 2 ))
|
||||
(D.runBytes
|
||||
(D.cell D.int D.int |> D.map Tuple.pair)
|
||||
(D.cell D.int D.int)
|
||||
(Bytes.fromByteValues [ 0x31, 0x12 ])
|
||||
)
|
||||
)
|
||||
@ -96,7 +96,7 @@ tests =
|
||||
Expect.equal
|
||||
(Just ( 4, [ 1, 2, 3 ] ))
|
||||
(D.runBytes
|
||||
(D.cell D.int (D.list D.int) |> D.map Tuple.pair)
|
||||
(D.cell D.int (D.list D.int))
|
||||
(Bytes.fromByteValues [ 0x61, 0xC6, 0x21, 0x43, 0x0B ])
|
||||
)
|
||||
)
|
||||
@ -105,7 +105,7 @@ tests =
|
||||
Expect.equal
|
||||
(Just ( 8, 11 ))
|
||||
(D.runBytes
|
||||
(D.cell D.float32 D.float32 |> D.map Tuple.pair)
|
||||
(D.cell D.float32 D.float32)
|
||||
(Bytes.fromByteValues [ 0x01, 0x1F, 0x00, 0x00, 0x20, 0x08, 0x7C, 0x00, 0x00, 0x98, 0x20 ])
|
||||
)
|
||||
)
|
||||
@ -114,7 +114,7 @@ tests =
|
||||
Expect.equal
|
||||
(Just ( 8, "hi" ))
|
||||
(D.runBytes
|
||||
(D.cell D.int D.cord |> D.map Tuple.pair)
|
||||
(D.cell D.int D.cord)
|
||||
(Bytes.fromByteValues [ 0x41, 0x10, 0x3C, 0x5A, 0x1A ])
|
||||
)
|
||||
)
|
||||
@ -123,7 +123,7 @@ tests =
|
||||
Expect.equal
|
||||
(Just ( 8, "hi" ))
|
||||
(D.runBytes
|
||||
(D.cell D.int D.tape |> D.map Tuple.pair)
|
||||
(D.cell D.int D.tape)
|
||||
(Bytes.fromByteValues [ 0x41, 0x30, 0x38, 0x3A, 0x78, 0x5A ])
|
||||
)
|
||||
)
|
||||
@ -134,8 +134,8 @@ tests =
|
||||
(Just "hi")
|
||||
(D.runBytes
|
||||
(D.oneOf
|
||||
[ D.cell (D.const D.cord "tape") D.tape
|
||||
, D.cell (D.const D.cord "cord") D.cord
|
||||
[ D.cell (D.const D.cord "tape") D.tape |> D.map (\((), t) -> t)
|
||||
, D.cell (D.const D.cord "cord") D.cord |> D.map (\((), c) -> c)
|
||||
]
|
||||
)
|
||||
(Bytes.fromByteValues [ 0x01, 0x9F, 0x2E, 0x0C, 0xAE, 0x1C, 0x1C, 0x1D, 0x3C, 0x2D ])
|
||||
@ -147,8 +147,8 @@ tests =
|
||||
(Just "hi")
|
||||
(D.runBytes
|
||||
(D.oneOf
|
||||
[ D.cell (D.const D.cord "tape") D.tape
|
||||
, D.cell (D.const D.cord "cord") D.cord
|
||||
[ D.cell (D.const D.cord "tape") D.tape |> D.map (\((), t) -> t)
|
||||
, D.cell (D.const D.cord "cord") D.cord |> D.map (\((), c) -> c)
|
||||
]
|
||||
)
|
||||
(Bytes.fromByteValues [ 0x01, 0x7F, 0xEC, 0x4D, 0x8E, 0x0C, 0x1E, 0x2D, 0x0D ])
|
||||
@ -160,7 +160,7 @@ tests =
|
||||
Expect.equal
|
||||
(Just ( 8, -8 ))
|
||||
(D.runBytes
|
||||
(D.cell D.signedInt D.signedInt |> D.map Tuple.pair)
|
||||
(D.cell D.signedInt D.signedInt)
|
||||
(Bytes.fromByteValues [ 0xC1, 0x20, 0xE4, 0x01 ])
|
||||
)
|
||||
)
|
||||
@ -190,7 +190,7 @@ tests =
|
||||
(\( f, i, ui ) ->
|
||||
Expect.equal (Just ( f, i, ui ))
|
||||
(D.run
|
||||
(D.cell D.float64 (D.cell D.signedInt D.int) |> D.map (\a b c -> ( a, b, c )))
|
||||
(D.cell D.float64 (D.cell D.signedInt D.int) |> D.map (\(a, (b, c)) -> ( a, b, c )))
|
||||
(C.cell (C.float64 f) (C.cell (C.signedInt i) (C.int ui)))
|
||||
)
|
||||
)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user