├── .gitignore ├── .local.vimrc ├── README.md ├── elm-package.json ├── src ├── Bright.elm ├── Bright │ ├── Cmds.elm │ ├── DB.elm │ ├── Decoder.elm │ ├── Encoder.elm │ ├── IO.elm │ ├── Model.elm │ ├── Ports.elm │ ├── Sub.elm │ ├── Update.elm │ ├── Uris.elm │ ├── Util.elm │ └── View.elm ├── Graph.elm ├── Main.elm └── Store.elm └── tests ├── .gitignore ├── Main.elm ├── Test ├── Bright.elm └── RemoteUpdate.elm ├── Tests.elm └── elm-package.json /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | *.swo 3 | node_modules 4 | lib 5 | dist 6 | elm-stuff 7 | elm.js 8 | -------------------------------------------------------------------------------- /.local.vimrc: -------------------------------------------------------------------------------- 1 | :let g:elm_format_autosave=1 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # BrightDB 2 | 3 | BrightDB is an offline-first, decentralized graph database for massively collaborative Web applications built on top of WebRTC, LevelDB and LSEQ, a conflict-free replicated data type. 4 | 5 | The project is still under heavy development and not ready for production use. 6 | 7 | ## What kind of apps is it good for? 8 | 9 | Any app that needs to 10 | * work irrespective of network connectivity 11 | * be updated in realtime 12 | * cope with concurrent changes 13 | * extend its data structure at runtime 14 | 15 | ## License 16 | 17 | BSD-3 18 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.2", 3 | "summary": "helpful summary of your project, less than 80 characters", 4 | "repository": "https://github.com/user/project.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | "src" 8 | ], 9 | "exposed-modules": [ 10 | 11 | ], 12 | "native-modules": true, 13 | "dependencies": { 14 | "elm-community/list-extra": "5.0.0 <= v < 6.0.0", 15 | "elm-community/maybe-extra": "3.0.1 <= v < 4.0.0", 16 | "elm-community/string-extra": "1.2.0 <= v < 2.0.0", 17 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 18 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 19 | "jinjor/elm-diff": "1.0.3 <= v < 2.0.0", 20 | "Skinney/elm-array-exploration": "2.0.2 <= v < 3.0.0", 21 | "git/elm-lseq" : "1.0.1 <= v < 2.0.0" 22 | }, 23 | "dependency-sources": { 24 | "git/elm-lseq": "http://matthias@localhost/git/elm-lseq.git" 25 | }, 26 | "elm-version": "0.18.0 <= v < 0.19.0" 27 | } 28 | -------------------------------------------------------------------------------- /src/Bright.elm: -------------------------------------------------------------------------------- 1 | module Bright exposing (..) 2 | 3 | import Html 4 | import Task exposing (Task) 5 | import Bright.Model exposing (..) 6 | import Bright.Encoder exposing (encodeLocalOperations) 7 | import Bright.Decoder exposing (decodeLocalOperations) 8 | import Bright.Uris as U 9 | import Bright.View 10 | import Bright.IO 11 | import Bright.Model 12 | import Bright.Update 13 | import Bright.Sub 14 | import Bright.DB exposing (Object(..)) 15 | import Graph exposing (Predicate, Subject, Local) 16 | import Array.Hamt as Array exposing (Array) 17 | import Maybe.Extra 18 | import List.Extra 19 | import String.Extra 20 | import Dict exposing (Dict) 21 | import LSEQ 22 | import LSEQ.Types as LSEQ 23 | import Tuple exposing (..) 24 | import String 25 | import Store 26 | import Diff 27 | 28 | 29 | type alias Uri = 30 | String 31 | 32 | 33 | type alias BBool = 34 | LSEQ.Entry Bool 35 | 36 | 37 | type alias BFloat = 38 | List (LSEQ.Entry Char) 39 | 40 | 41 | type alias BRef = 42 | LSEQ.Entry Uri 43 | 44 | 45 | type alias BString = 46 | List (LSEQ.Entry Char) 47 | 48 | 49 | type alias Object = 50 | Bright.DB.Object 51 | 52 | 53 | type alias Entity = 54 | Bright.DB.Entity 55 | 56 | 57 | type alias Entities = 58 | Bright.DB.Entities 59 | 60 | 61 | class : Uri -> ( Predicate, List (Local Uri) ) 62 | class uri = 63 | ( U.isA 64 | , [ ( ( "", 0 ), LSEQ.Insert uri ) 65 | ] 66 | ) 67 | 68 | 69 | insert : Int -> a -> List (Local a) 70 | insert pos a = 71 | [ ( ( "", pos ), LSEQ.Insert a ) 72 | ] 73 | 74 | 75 | string : String -> List (Local Char) 76 | string string = 77 | String.toList string 78 | |> List.indexedMap 79 | (\i -> (,) ( "", i ) >> (mapSecond LSEQ.Insert)) 80 | 81 | 82 | bool : Bool -> List (Local Char) 83 | bool new = 84 | [ ( ( "", 0 ) 85 | , LSEQ.Insert <| 86 | if new then 87 | '1' 88 | else 89 | '0' 90 | ) 91 | ] 92 | 93 | 94 | float : Float -> List (Local Char) 95 | float new = 96 | toString new 97 | |> string 98 | 99 | 100 | ref : Uri -> List (Local Uri) 101 | ref uri = 102 | [ ( ( "", 0 ) 103 | , LSEQ.Insert uri 104 | ) 105 | ] 106 | 107 | 108 | deleteRef : Uri -> List (Local Uri) 109 | deleteRef target = 110 | [ ( ( target, 0 ) 111 | , LSEQ.Remove 112 | ) 113 | ] 114 | 115 | 116 | {-| Compares input string and current string and creates an operation given the first char of the two string that do not match. If the input string is shorter than the current string, it's a remove operation, if longer, it's an insert operation, if equal it's a noop. 117 | char : String -> String -> List Local 118 | char current string = 119 | diffOperation String.fromChar (String.toList current) <| 120 | String.toList string 121 | uri : List Uri -> List Uri -> List Local 122 | uri current list = 123 | diffOperation identity current list 124 | -} 125 | remove : ( Uri, Int ) -> List (Local Uri) 126 | remove id = 127 | [ ( id, LSEQ.Remove ) 128 | ] 129 | 130 | 131 | removeAll : List (LSEQ.Entry Char) -> List (Local Char) 132 | removeAll chars = 133 | List.foldl 134 | (\entry ( locals, i ) -> 135 | case entry of 136 | LSEQ.Single o (LSEQ.Value v) -> 137 | ( ( ( o, i ), LSEQ.Remove ) :: locals 138 | , i + 1 139 | ) 140 | 141 | LSEQ.MVR dict -> 142 | Dict.foldl 143 | (\t v locals -> 144 | case v of 145 | LSEQ.Value v -> 146 | ( ( t, i ), LSEQ.Remove ) :: locals 147 | 148 | _ -> 149 | locals 150 | ) 151 | locals 152 | dict 153 | |> (\locals -> ( locals, i + 1 )) 154 | 155 | _ -> 156 | ( locals, i ) 157 | ) 158 | ( [], 0 ) 159 | chars 160 | |> first 161 | 162 | 163 | 164 | {- 165 | diffOperation : (a -> String) -> List a -> List a -> List Local 166 | diffOperation toString chars1 chars2 = 167 | let 168 | len1 = 169 | List.length chars1 170 | 171 | len2 = 172 | List.length chars2 173 | 174 | pos = 175 | List.map2 (,) chars1 chars2 176 | |> List.Extra.findIndex 177 | (\( a, b ) -> a /= b) 178 | |> Maybe.withDefault (min len1 len2) 179 | in 180 | if len1 > len2 then 181 | [ ( pos, LSEQ.Remove ) 182 | ] 183 | else if len1 < len2 then 184 | case List.Extra.getAt pos chars2 of 185 | Nothing -> 186 | [] 187 | 188 | Just char -> 189 | [ ( pos, LSEQ.Insert (toString char) ) 190 | ] 191 | else 192 | [] 193 | -} 194 | 195 | 196 | isOf : String -> Entity -> Bool 197 | isOf uri entity = 198 | let 199 | byValue uri item = 200 | case item of 201 | LSEQ.Single _ (LSEQ.Value u) -> 202 | u == uri 203 | 204 | LSEQ.MVR mvr -> 205 | Dict.values mvr |> List.member (LSEQ.Value uri) 206 | 207 | _ -> 208 | False 209 | in 210 | case Dict.get U.isA entity of 211 | Just (Ref values) -> 212 | List.Extra.find (byValue uri) values |> (/=) Nothing 213 | 214 | _ -> 215 | False 216 | 217 | 218 | 219 | {- 220 | applyLocalStringOps : List Local -> String -> String 221 | applyLocalStringOps locals string = 222 | List.foldl 223 | (\( pos, op ) string -> 224 | case op of 225 | LSEQ.Insert a -> 226 | String.Extra.insertAt a pos string 227 | 228 | LSEQ.Remove -> 229 | String.Extra.replaceSlice "" pos (pos + 1) string 230 | ) 231 | string 232 | locals 233 | 234 | applyLocalBoolOps : List Local -> Bool -> Bool 235 | applyLocalBoolOps locals bool = 236 | applyLocalStringOps locals 237 | (if bool then 238 | "1" 239 | else 240 | "0" 241 | ) 242 | |> (==) "1" 243 | 244 | 245 | applyLocalUriOps : List Local -> (Uri -> a) -> List a -> List a 246 | applyLocalUriOps locals init list = 247 | List.foldl 248 | (\( pos, op ) list -> 249 | case op of 250 | LSEQ.Insert uri -> 251 | List.drop pos list 252 | |> (::) (init uri) 253 | |> (++) (List.take pos list) 254 | 255 | LSEQ.Remove -> 256 | List.Extra.removeAt pos list 257 | ) 258 | list 259 | locals 260 | 261 | -} 262 | 263 | 264 | valueOnly2String : List (LSEQ.ValueOnly String) -> String 265 | valueOnly2String = 266 | List.foldl 267 | (\value string -> 268 | case value of 269 | LSEQ.SingleValue _ v -> 270 | string ++ v 271 | 272 | LSEQ.Concurrent mvr -> 273 | Dict.toList mvr 274 | |> List.sortBy first 275 | |> List.head 276 | |> Maybe.map second 277 | |> Maybe.withDefault "" 278 | |> (++) string 279 | ) 280 | "" 281 | 282 | 283 | initBBool : Uri -> Bool -> BBool 284 | initBBool origin bool = 285 | LSEQ.Single origin (LSEQ.Value bool) 286 | 287 | 288 | initBFloat : Uri -> Float -> BFloat 289 | initBFloat origin fl = 290 | toString fl 291 | |> String.toList 292 | |> List.map (LSEQ.Value >> LSEQ.Single origin) 293 | 294 | 295 | initBString : Uri -> String -> BString 296 | initBString = 297 | string2ValueList 298 | 299 | 300 | toBBool : Object -> Maybe BBool 301 | toBBool object = 302 | case object of 303 | Ref _ -> 304 | Nothing 305 | 306 | Literal list -> 307 | List.head list 308 | |> Maybe.map 309 | (LSEQ.mapEntry 310 | (\v -> 311 | if v == '1' then 312 | True 313 | else 314 | False 315 | ) 316 | ) 317 | 318 | 319 | toBRef : Object -> Maybe BRef 320 | toBRef object = 321 | case object of 322 | Ref list -> 323 | List.head list 324 | 325 | Literal list -> 326 | Nothing 327 | 328 | 329 | toBString : Object -> BString 330 | toBString object = 331 | case object of 332 | Ref list -> 333 | [] 334 | 335 | Literal list -> 336 | list 337 | 338 | 339 | toBFloat : Object -> BFloat 340 | toBFloat = 341 | toBString 342 | 343 | 344 | bRefToUri : Uri -> BRef -> Maybe Uri 345 | bRefToUri origin ref = 346 | case ref of 347 | LSEQ.Single _ (LSEQ.Value uri) -> 348 | Just uri 349 | 350 | LSEQ.MVR mvr -> 351 | case Dict.get origin mvr of 352 | Just (LSEQ.Value uri) -> 353 | Just uri 354 | 355 | _ -> 356 | (Dict.toList mvr 357 | |> List.sortBy first 358 | |> List.head 359 | |> Maybe.map second 360 | |> Maybe.map 361 | (\v -> 362 | case v of 363 | LSEQ.Value uri -> 364 | Just uri 365 | 366 | _ -> 367 | Nothing 368 | ) 369 | |> Maybe.Extra.join 370 | ) 371 | 372 | _ -> 373 | Nothing 374 | 375 | 376 | bFloatToFloat : Uri -> BFloat -> Result String Float 377 | bFloatToFloat origin float = 378 | purge float 379 | |> List.map 380 | (\c -> 381 | case c of 382 | LSEQ.SingleValue _ b -> 383 | String.fromChar b 384 | 385 | LSEQ.Concurrent mvr -> 386 | case Dict.get origin mvr of 387 | Just b -> 388 | String.fromChar b 389 | 390 | Nothing -> 391 | (Dict.toList mvr 392 | |> List.sortBy first 393 | |> List.head 394 | |> Maybe.map second 395 | |> Maybe.map String.fromChar 396 | |> Maybe.withDefault "" 397 | ) 398 | ) 399 | |> String.concat 400 | |> String.toFloat 401 | 402 | 403 | bBoolToBool : Uri -> BBool -> Bool 404 | bBoolToBool origin bool = 405 | case bool of 406 | LSEQ.Single _ (LSEQ.Value b) -> 407 | b 408 | 409 | LSEQ.MVR mvr -> 410 | case Dict.get origin mvr of 411 | Just (LSEQ.Value b) -> 412 | b 413 | 414 | _ -> 415 | (Dict.toList mvr 416 | |> List.sortBy first 417 | |> List.head 418 | |> Maybe.map second 419 | |> Maybe.map 420 | (\v -> 421 | case v of 422 | LSEQ.Value b -> 423 | b 424 | 425 | _ -> 426 | False 427 | ) 428 | |> Maybe.withDefault False 429 | ) 430 | 431 | _ -> 432 | False 433 | 434 | 435 | bStringToString : Uri -> BString -> String 436 | bStringToString origin string = 437 | let 438 | value2String v = 439 | case v of 440 | LSEQ.Tomb _ -> 441 | Nothing 442 | 443 | LSEQ.Value v -> 444 | Just <| String.fromChar v 445 | in 446 | string 447 | |> List.foldl 448 | (\value str -> 449 | case value of 450 | LSEQ.Single _ v -> 451 | str ++ (value2String v |> Maybe.withDefault "") 452 | 453 | LSEQ.MVR mvr -> 454 | Dict.get origin mvr 455 | |> Maybe.map value2String 456 | |> Maybe.Extra.join 457 | |> Maybe.withDefault 458 | (Dict.toList mvr 459 | |> List.sortBy first 460 | |> List.foldl 461 | (\( origin, value ) result -> 462 | case result of 463 | Nothing -> 464 | value2String value 465 | 466 | Just _ -> 467 | result 468 | ) 469 | Nothing 470 | |> Maybe.withDefault "" 471 | ) 472 | |> (++) str 473 | ) 474 | "" 475 | 476 | 477 | valueList2LocalOps : List (LSEQ.Entry a) -> List (Local a) 478 | valueList2LocalOps list = 479 | list 480 | |> List.indexedMap value2LocalOp 481 | |> List.filterMap identity 482 | 483 | 484 | value2LocalOp : Int -> LSEQ.Entry a -> Maybe (Local a) 485 | value2LocalOp pos value = 486 | case value of 487 | LSEQ.Single target (LSEQ.Value v) -> 488 | Just ( ( target, pos ), LSEQ.Insert v ) 489 | 490 | _ -> 491 | Nothing 492 | 493 | 494 | purge : List (LSEQ.Entry a) -> List (LSEQ.ValueOnly a) 495 | purge = 496 | List.filterMap 497 | (\v -> 498 | case v of 499 | LSEQ.Single target (LSEQ.Value a) -> 500 | Just <| LSEQ.SingleValue target a 501 | 502 | LSEQ.Single target (LSEQ.Tomb a) -> 503 | Nothing 504 | 505 | LSEQ.MVR mvr -> 506 | Dict.toList mvr 507 | |> List.filterMap 508 | (\( k, v ) -> 509 | case v of 510 | LSEQ.Value a -> 511 | Just ( k, a ) 512 | 513 | _ -> 514 | Nothing 515 | ) 516 | |> (\list -> 517 | if List.isEmpty list then 518 | Nothing 519 | else 520 | Dict.fromList list 521 | |> LSEQ.Concurrent 522 | |> Just 523 | ) 524 | ) 525 | 526 | 527 | toList : List (LSEQ.Entry Uri) -> List Uri 528 | toList entryList = 529 | entryList 530 | |> List.filterMap 531 | (\entry -> 532 | case entry of 533 | LSEQ.Single _ (LSEQ.Value uri) -> 534 | Just [ uri ] 535 | 536 | LSEQ.MVR dict -> 537 | Dict.toList dict 538 | |> List.filterMap 539 | (\( k, v ) -> 540 | case v of 541 | LSEQ.Value uri -> 542 | Just uri 543 | 544 | _ -> 545 | Nothing 546 | ) 547 | |> Just 548 | 549 | _ -> 550 | Nothing 551 | ) 552 | |> List.concat 553 | 554 | 555 | loadByType : Entities -> model -> List ( Uri, model -> Subject -> Entity -> ( model, Cmd msg ) ) -> ( model, Cmd msg ) 556 | loadByType entities model map = 557 | Store.toDicts entities 558 | |> Dict.foldl 559 | (\s entity ( model, cmds ) -> 560 | List.foldl 561 | (\( typeUri, load ) ( model, cmds ) -> 562 | (if isOf typeUri entity then 563 | load model s entity 564 | else 565 | ( model, Cmd.none ) 566 | ) 567 | |> mapSecond (\cmd -> cmd :: cmds) 568 | ) 569 | ( model, cmds ) 570 | map 571 | ) 572 | ( model, [] ) 573 | |> mapSecond Cmd.batch 574 | 575 | 576 | load : model -> List ( Uri, model -> Object -> ( model, Cmd msg ) ) -> Entity -> ( model, Cmd msg ) 577 | load model map = 578 | Dict.foldl 579 | (\p current ( model, cmds ) -> 580 | List.foldl 581 | (\( predicate, load ) ( model, cmds ) -> 582 | (if p == predicate then 583 | load model current 584 | else 585 | ( model, Cmd.none ) 586 | ) 587 | |> mapSecond (\cmd -> cmd :: cmds) 588 | ) 589 | ( model, cmds ) 590 | map 591 | ) 592 | ( model, [] ) 593 | >> mapSecond Cmd.batch 594 | 595 | 596 | find : Uri -> List { a | uri : Subject } -> Maybe { a | uri : Subject } 597 | find s = 598 | List.Extra.find (predicate s) 599 | 600 | 601 | replace : Uri -> { a | uri : Subject } -> List { a | uri : Subject } -> List { a | uri : Subject } 602 | replace s = 603 | List.Extra.replaceIf (predicate s) 604 | 605 | 606 | removeByUri : Uri -> List { a | uri : Subject } -> List { a | uri : Subject } 607 | removeByUri uri = 608 | List.filter (.uri >> (/=) uri) 609 | 610 | 611 | predicate : Uri -> { a | uri : Subject } -> Bool 612 | predicate uri = 613 | (.uri >> (==) uri) 614 | 615 | 616 | emptyBString : BString 617 | emptyBString = 618 | [] 619 | 620 | 621 | loadUnorderedListItem : 622 | (Subject -> { list | uri : Subject }) 623 | -> (Subject -> { item | uri : Subject }) 624 | -> ({ list | uri : Subject } -> List { item | uri : Subject }) 625 | -> ({ list | uri : Subject } -> List { item | uri : Subject } -> { list | uri : Subject }) 626 | -> (Uri -> Object -> { item | uri : Subject } -> { item | uri : Subject }) 627 | -> Uri 628 | -> List { list | uri : Subject } 629 | -> Subject 630 | -> Entity 631 | -> ( List { list | uri : Subject }, Cmd msg ) 632 | loadUnorderedListItem initList initItem getSublist updateSublist foldItem parentListUri listOfLists s entity = 633 | let 634 | ( oldLists, item ) = 635 | listOfLists 636 | |> List.foldl 637 | (\list ( found, item ) -> 638 | case find s <| getSublist list of 639 | Just f -> 640 | ( list :: found, f ) 641 | 642 | Nothing -> 643 | ( found, item ) 644 | ) 645 | ( [], initItem s ) 646 | 647 | ( newLists, cmds ) = 648 | Dict.get parentListUri entity 649 | |> Maybe.map toBRef 650 | |> Maybe.Extra.join 651 | |> toList 652 | |> List.unzip 653 | 654 | toList object = 655 | case object of 656 | Just (LSEQ.Single _ (LSEQ.Value listUri)) -> 657 | [ List.Extra.find (predicate listUri) listOfLists 658 | |> Maybe.map (\list -> ( ( list, False ), Cmd.none )) 659 | |> Maybe.withDefault 660 | ( ( initList listUri, True ) 661 | , Cmd.batch 662 | [ Bright.IO.query ( listUri, "*", "*" ) 663 | ] 664 | ) 665 | ] 666 | 667 | Just (LSEQ.MVR mvr) -> 668 | Dict.values mvr 669 | |> List.filterMap 670 | (\listUri -> 671 | case listUri of 672 | LSEQ.Tomb _ -> 673 | Nothing 674 | 675 | LSEQ.Value listUri -> 676 | find listUri listOfLists 677 | |> Maybe.map (\list -> ( ( list, False ), Cmd.none )) 678 | |> Maybe.withDefault 679 | ( ( initList listUri, True ) 680 | , Cmd.batch 681 | [ Bright.IO.query ( listUri, "*", "*" ) 682 | ] 683 | ) 684 | |> Just 685 | ) 686 | 687 | _ -> 688 | [] 689 | 690 | findInSublist s list = 691 | getSublist list 692 | |> find s 693 | |> (/=) Nothing 694 | 695 | newItem = 696 | Dict.foldl foldItem item entity 697 | |> Debug.log "newItem" 698 | 699 | ( oldLists_, newLists_, unchangedLists ) = 700 | ( List.filter (\list -> List.Extra.find (first >> predicate list.uri) newLists |> (==) Nothing) oldLists 701 | , List.filter (\( list, _ ) -> List.Extra.find (predicate list.uri) oldLists |> (==) Nothing) newLists 702 | , List.filter (\( list, _ ) -> List.Extra.find (predicate list.uri) oldLists |> (/=) Nothing) newLists 703 | ) 704 | 705 | oldLists__ = 706 | List.map 707 | (\list -> 708 | getSublist list 709 | |> List.filter (.uri >> (/=) s) 710 | |> updateSublist list 711 | ) 712 | oldLists_ 713 | |> Debug.log "oldTodolists" 714 | 715 | newLists__ = 716 | List.map 717 | (mapFirst 718 | (\list -> 719 | getSublist list 720 | |> (::) newItem 721 | |> updateSublist list 722 | ) 723 | ) 724 | newLists_ 725 | |> Debug.log "newTodolists" 726 | 727 | unchangedLists_ = 728 | List.map 729 | (mapFirst 730 | (\list -> 731 | getSublist list 732 | |> replace s newItem 733 | |> updateSublist list 734 | ) 735 | ) 736 | unchangedLists 737 | |> Debug.log "unchangedTodolists" 738 | in 739 | ( (List.map ((flip (,)) False) oldLists__) 740 | ++ newLists__ 741 | ++ unchangedLists_ 742 | |> List.foldl 743 | (\( list, isNew ) lists -> 744 | if isNew then 745 | list :: lists 746 | else 747 | replace list.uri list lists 748 | ) 749 | listOfLists 750 | , cmds 751 | |> Cmd.batch 752 | ) 753 | 754 | 755 | string2ValueList : String -> String -> List (LSEQ.Entry Char) 756 | string2ValueList origin str = 757 | String.toList str 758 | |> List.map (LSEQ.Single origin << LSEQ.Value) 759 | 760 | 761 | isValue : LSEQ.Value a -> Bool 762 | isValue v = 763 | case v of 764 | LSEQ.Value _ -> 765 | True 766 | 767 | LSEQ.Tomb _ -> 768 | False 769 | 770 | 771 | isCementary : LSEQ.Entry a -> Bool 772 | isCementary entry = 773 | case entry of 774 | LSEQ.MVR mvr -> 775 | Dict.values mvr |> List.any isValue |> not 776 | 777 | LSEQ.Single _ (LSEQ.Tomb _) -> 778 | True 779 | 780 | _ -> 781 | False 782 | 783 | 784 | diffString : Uri -> BString -> String -> ( BString, List (Local Char) ) 785 | diffString namespace old new = 786 | let 787 | oldString = 788 | bStringToString namespace old 789 | |> Debug.log "old" 790 | 791 | diff = 792 | Diff.diff (String.toList oldString) (String.toList new) 793 | |> Debug.log "diff" 794 | 795 | foldChange change ( newStr, oldvalues, operations, i ) = 796 | let 797 | added c = 798 | ( newStr ++ [ LSEQ.Single namespace (LSEQ.Value c) ] 799 | , oldvalues 800 | , operations ++ [ ( ( namespace, i ), LSEQ.Insert c ) ] 801 | , i + 1 802 | ) 803 | in 804 | case oldvalues of 805 | oldvalue :: rest -> 806 | if isCementary oldvalue then 807 | foldChange change ( newStr, rest, operations, i ) 808 | else 809 | case change of 810 | Diff.Removed char -> 811 | let 812 | ( newStr_, localOp, i_ ) = 813 | case oldvalue of 814 | LSEQ.Single target (LSEQ.Value v) -> 815 | ( newStr, Just ( ( target, i ), LSEQ.Remove ), i ) 816 | 817 | LSEQ.Single target (LSEQ.Tomb v) -> 818 | -- cannot happen, since already filtered by isCementary 819 | ( newStr, Nothing, i ) 820 | 821 | LSEQ.MVR mvr -> 822 | case Dict.get namespace mvr of 823 | Just (LSEQ.Value v) -> 824 | let 825 | mvr_ = 826 | Dict.insert namespace (LSEQ.Tomb v) mvr 827 | in 828 | ( newStr ++ [ LSEQ.MVR mvr_ ] 829 | , Just ( ( namespace, i ), LSEQ.Remove ) 830 | , i 831 | + (if Dict.values mvr_ |> List.any isValue then 832 | 1 833 | else 834 | 0 835 | ) 836 | ) 837 | 838 | _ -> 839 | (Dict.toList mvr 840 | |> List.filterMap 841 | (\( k, v ) -> 842 | case v of 843 | LSEQ.Tomb _ -> 844 | Nothing 845 | 846 | LSEQ.Value v -> 847 | Just ( k, v ) 848 | ) 849 | |> List.sortBy first 850 | |> List.head 851 | |> Maybe.map 852 | (\( target, v ) -> 853 | let 854 | mvr_ = 855 | Dict.insert target (LSEQ.Tomb v) mvr 856 | in 857 | ( newStr ++ [ LSEQ.MVR mvr_ ] 858 | , Just ( ( target, i ), LSEQ.Remove ) 859 | , i 860 | + (if Dict.values mvr_ |> List.any isValue then 861 | 1 862 | else 863 | 0 864 | ) 865 | ) 866 | ) 867 | |> Maybe.withDefault ( newStr, Nothing, i ) 868 | ) 869 | 870 | operations_ = 871 | Maybe.map (\l -> operations ++ [ l ]) localOp 872 | |> Maybe.withDefault operations 873 | in 874 | ( newStr_, rest, operations_, i_ ) 875 | 876 | Diff.Added c -> 877 | added c 878 | 879 | Diff.NoChange _ -> 880 | ( newStr ++ [ oldvalue ], rest, operations, i + 1 ) 881 | 882 | [] -> 883 | case change of 884 | Diff.Added c -> 885 | added c 886 | 887 | _ -> 888 | ( newStr, [], operations, i ) 889 | 890 | ( newStr, _, operations, _ ) = 891 | List.foldl foldChange ( [], old, [], 0 ) diff 892 | in 893 | ( newStr, operations ) 894 | 895 | 896 | main = 897 | Html.programWithFlags 898 | { init = Bright.Model.init 899 | , update = Bright.Update.update 900 | , subscriptions = Bright.Sub.subscriptions 901 | , view = Bright.View.view 902 | } 903 | -------------------------------------------------------------------------------- /src/Bright/Cmds.elm: -------------------------------------------------------------------------------- 1 | module Bright.Cmds exposing (..) 2 | 3 | import Dict 4 | import Set 5 | import Array.Hamt as Array 6 | import Json.Encode as Enc 7 | import Tuple exposing (first, second) 8 | import List.Extra 9 | import Bright.Encoder exposing (..) 10 | import Bright.Model exposing (..) 11 | import Bright.Util exposing (..) 12 | import Bright.Ports 13 | import Bright.Uris as U 14 | import Graph exposing (Subject, Predicate, Uri, State) 15 | import Bright.DB exposing (Entities, Query, RemoteOperations, Meta, States) 16 | import LSEQ 17 | import Store 18 | 19 | 20 | subscribeByMeta : Model -> Uri -> Meta -> Cmd msg 21 | subscribeByMeta model peer meta = 22 | Dict.foldl 23 | (\s ps states -> 24 | Set.toList ps 25 | |> List.foldl 26 | (\p -> 27 | Store.insertObject s p (currentState model peer ( s, p )) 28 | ) 29 | states 30 | ) 31 | Store.empty 32 | meta 33 | |> subscribe peer 34 | 35 | 36 | subscribe : Uri -> States -> Cmd msg 37 | subscribe peer = 38 | encodeStates 39 | >> encodePeer peer 40 | >> Bright.Ports.send 41 | 42 | 43 | localResult : App -> Entities -> Cmd msg 44 | localResult app entities = 45 | encodeEntities entities 46 | |> encodeApp app 47 | |> Bright.Ports.appLoad 48 | 49 | 50 | remoteResult : Peer -> RemoteOperations -> Cmd msg 51 | remoteResult peer result = 52 | encodeRemoteOperations result 53 | |> encodePeer peer 54 | |> Bright.Ports.send 55 | 56 | 57 | queryMeta : List Peer -> Query -> Cmd msg 58 | queryMeta peers query = 59 | let 60 | encoded = 61 | encodeQuery query 62 | in 63 | peers 64 | |> List.map 65 | (\peer -> 66 | encodePeer peer encoded 67 | |> Bright.Ports.send 68 | ) 69 | |> Cmd.batch 70 | 71 | 72 | requeryMeta : Peer -> Query -> Cmd msg 73 | requeryMeta peer query = 74 | encodeRequery query 75 | |> encodePeer peer 76 | |> Bright.Ports.send 77 | 78 | 79 | sendMeta : Peer -> Meta -> Cmd msg 80 | sendMeta peer meta = 81 | encodeMeta meta 82 | |> encodePeer peer 83 | |> Bright.Ports.send 84 | -------------------------------------------------------------------------------- /src/Bright/DB.elm: -------------------------------------------------------------------------------- 1 | module Bright.DB exposing (..) 2 | 3 | {-| 4 | @docs CharOrRefOps,CharOrRefRemoteOps,Entities,Entity,LocalOperations,Meta,Object,Query,RemoteOperations,States,Store,getPast,mutate,mutateRemote,noRemotes,opsLength,query,queryMeta,wildcard 5 | -} 6 | 7 | import Graph exposing (Graph, Subject, Predicate, Uri, State) 8 | import Set exposing (Set) 9 | import Dict exposing (Dict) 10 | import Store 11 | import LSEQ exposing (LSEQ) 12 | import LSEQ.Types as LSEQ 13 | import Task exposing (Task) 14 | import Tuple exposing (..) 15 | import Array.Hamt as Array 16 | 17 | 18 | {-| 19 | -} 20 | type alias States = 21 | Store State 22 | 23 | 24 | {-| 25 | -} 26 | type alias RemoteOperations = 27 | Store ( CharOrRefRemoteOps, Graph.State ) 28 | 29 | 30 | {-| 31 | -} 32 | type alias LocalOperations = 33 | Store CharOrRefOps 34 | 35 | 36 | {-| 37 | -} 38 | type CharOrRefOps 39 | = CharOps (List (Graph.Local Char)) 40 | | RefOps (List (Graph.Local Uri)) 41 | 42 | 43 | {-| 44 | -} 45 | type CharOrRefRemoteOps 46 | = CharRemoteOps (List (Graph.Remote Char)) 47 | | RefRemoteOps (List (Graph.Remote Uri)) 48 | 49 | 50 | {-| 51 | -} 52 | type Object 53 | = Ref (List (LSEQ.Entry Uri)) 54 | | Literal (List (LSEQ.Entry Char)) 55 | 56 | 57 | {-| 58 | -} 59 | wildcard : String 60 | wildcard = 61 | "*" 62 | 63 | 64 | {-| 65 | -} 66 | type alias Store a = 67 | Store.Store Subject Predicate a 68 | 69 | 70 | {-| 71 | A list of objects because a predicate could be used more than once 72 | -} 73 | type alias Entities = 74 | Store Object 75 | 76 | 77 | {-| 78 | -} 79 | type alias Meta = 80 | Dict Subject (Set Predicate) 81 | 82 | 83 | {-| 84 | -} 85 | type alias Entity = 86 | Dict Predicate Object 87 | 88 | 89 | {-| 90 | -} 91 | type alias Query = 92 | ( Uri, Uri, Uri ) 93 | 94 | 95 | {-| 96 | -} 97 | opsLength : CharOrRefRemoteOps -> Int 98 | opsLength ops = 99 | case ops of 100 | CharRemoteOps ops -> 101 | List.length ops 102 | 103 | RefRemoteOps ops -> 104 | List.length ops 105 | 106 | 107 | {-| 108 | -} 109 | queryMeta : Graph -> Query -> Meta 110 | queryMeta graph (( s, p, o ) as q) = 111 | if s == wildcard && p == wildcard && o == wildcard then 112 | Dict.map 113 | (\s node -> 114 | Dict.keys node.outgoing 115 | ++ Dict.keys node.body 116 | |> Set.fromList 117 | ) 118 | graph 119 | else if s == wildcard && p /= wildcard && o /= wildcard then 120 | case Graph.get o graph of 121 | Nothing -> 122 | Dict.empty 123 | 124 | Just node -> 125 | node.incoming 126 | |> Dict.foldl 127 | (\p_ subjects result -> 128 | if p /= p_ then 129 | result 130 | else 131 | subjects 132 | |> Set.foldl 133 | (\s result -> 134 | case Graph.get s graph of 135 | Nothing -> 136 | result 137 | 138 | Just node -> 139 | if Dict.member p node.body || Dict.member p node.outgoing then 140 | Dict.update s 141 | (Maybe.withDefault Set.empty 142 | >> Set.insert p 143 | >> Just 144 | ) 145 | result 146 | else 147 | result 148 | ) 149 | result 150 | ) 151 | Dict.empty 152 | else if s /= wildcard && o == wildcard then 153 | case Graph.get s graph of 154 | Nothing -> 155 | Dict.empty 156 | 157 | Just node -> 158 | (Dict.keys node.body ++ Dict.keys node.outgoing) 159 | |> Set.fromList 160 | |> Dict.singleton s 161 | else 162 | Dict.empty 163 | 164 | 165 | {-| 166 | -} 167 | query : Graph -> Query -> Entities 168 | query graph (( s, p, o ) as q) = 169 | let 170 | foldOutgoing ( s, p, o ) outgoing result = 171 | Dict.foldl 172 | (\p_ lseqUri result -> 173 | if p /= wildcard && p_ /= p then 174 | result 175 | else 176 | Store.insertObject s p_ (Ref <| LSEQ.toList lseqUri) result 177 | ) 178 | result 179 | outgoing 180 | 181 | foldBody ( s, p, o ) body result = 182 | Dict.foldl 183 | (\p_ lseqChar result -> 184 | if p /= wildcard && p_ /= p then 185 | result 186 | else 187 | Store.insertObject s p_ (Literal <| LSEQ.toList lseqChar) result 188 | ) 189 | result 190 | body 191 | in 192 | if s == wildcard && p /= wildcard && o /= wildcard then 193 | case Graph.get o graph of 194 | Nothing -> 195 | Store.empty 196 | 197 | Just node -> 198 | node.incoming 199 | |> Dict.foldl 200 | (\p_ subjects result -> 201 | if p /= p_ then 202 | result 203 | else 204 | subjects 205 | |> Set.foldl 206 | (\s result -> 207 | case Graph.get s graph of 208 | Nothing -> 209 | result 210 | 211 | Just node -> 212 | case Dict.get p node.body of 213 | Nothing -> 214 | case Dict.get p node.outgoing of 215 | Nothing -> 216 | result 217 | 218 | Just lseqUri -> 219 | Store.insertObject s p (Ref <| LSEQ.toList lseqUri) result 220 | 221 | Just lseqChar -> 222 | Store.insertObject s p (Literal <| LSEQ.toList lseqChar) result 223 | ) 224 | result 225 | ) 226 | Store.empty 227 | else if s /= wildcard && o == wildcard then 228 | case Graph.get s graph of 229 | Nothing -> 230 | Store.empty 231 | 232 | Just node -> 233 | foldOutgoing q node.outgoing Store.empty 234 | |> foldBody q node.body 235 | else 236 | Store.empty 237 | 238 | 239 | {-| 240 | -} 241 | mutate : Graph -> Uri -> LocalOperations -> ( Graph, RemoteOperations ) 242 | mutate graph origin localOps = 243 | localOps 244 | |> Store.foldl 245 | (\s p locals ( graph, remoteOps ) -> 246 | case locals of 247 | CharOps locals -> 248 | Graph.applyCharOps origin s p (Graph.Locals locals) graph 249 | |> mapSecond 250 | (\( remotes, state ) -> 251 | if List.isEmpty remotes then 252 | remoteOps 253 | else 254 | Store.insertObject s p ( (CharRemoteOps remotes), state ) remoteOps 255 | ) 256 | 257 | RefOps locals -> 258 | Graph.applyRefOps origin s p (Graph.Locals locals) graph 259 | |> mapSecond 260 | (\( remotes, state ) -> 261 | if List.isEmpty remotes then 262 | remoteOps 263 | else 264 | Store.insertObject s p ( (RefRemoteOps remotes), state ) remoteOps 265 | ) 266 | ) 267 | ( graph, Store.empty ) 268 | 269 | 270 | {-| 271 | -} 272 | mutateRemote : Graph -> RemoteOperations -> ( Graph, RemoteOperations ) 273 | mutateRemote graph remoteOps = 274 | remoteOps 275 | |> Store.foldl 276 | (\s p ( remotes, _ ) ( graph, remoteOps ) -> 277 | case remotes of 278 | CharRemoteOps remotes -> 279 | Graph.applyCharOps "" s p (Graph.Remotes remotes) graph 280 | |> mapSecond 281 | (\( remotes, state ) -> 282 | if List.isEmpty remotes then 283 | remoteOps 284 | else 285 | Store.insertObject s p ( (CharRemoteOps remotes), state ) remoteOps 286 | ) 287 | 288 | RefRemoteOps remotes -> 289 | Graph.applyRefOps "" s p (Graph.Remotes remotes) graph 290 | |> mapSecond 291 | (\( remotes, state ) -> 292 | if List.isEmpty remotes then 293 | remoteOps 294 | else 295 | Store.insertObject s p ( (RefRemoteOps remotes), state ) remoteOps 296 | ) 297 | ) 298 | ( graph, Store.empty ) 299 | 300 | 301 | {-| 302 | -} 303 | noRemotes : ( CharOrRefRemoteOps, State ) 304 | noRemotes = 305 | ( CharRemoteOps [], -1 ) 306 | 307 | 308 | {-| 309 | -} 310 | getPast : Graph -> States -> RemoteOperations 311 | getPast graph states = 312 | states 313 | |> Store.map 314 | (\s p state -> 315 | case Graph.get s graph of 316 | Nothing -> 317 | noRemotes 318 | 319 | Just node -> 320 | case Dict.get p node.body of 321 | Nothing -> 322 | case Dict.get p node.outgoing of 323 | Nothing -> 324 | noRemotes 325 | 326 | Just lseqUri -> 327 | ( LSEQ.Offset state 328 | |> LSEQ.getPast lseqUri 329 | |> Array.toList 330 | |> RefRemoteOps 331 | , LSEQ.currentState lseqUri 332 | ) 333 | 334 | Just lseqChar -> 335 | ( LSEQ.Offset state 336 | |> LSEQ.getPast lseqChar 337 | |> Array.toList 338 | |> CharRemoteOps 339 | , LSEQ.currentState lseqChar 340 | ) 341 | ) 342 | -------------------------------------------------------------------------------- /src/Bright/Decoder.elm: -------------------------------------------------------------------------------- 1 | module Bright.Decoder exposing (..) 2 | 3 | import Dict exposing (Dict) 4 | import Json.Decode as Dec exposing (Decoder) 5 | import Bright.Model exposing (..) 6 | import Bright.Update exposing (Msg(..)) 7 | import Bright.DB exposing (Query, Entities, Object(..), RemoteOperations, LocalOperations, CharOrRefOps(..), CharOrRefRemoteOps(..), Meta, States) 8 | import Graph exposing (Subject, Predicate, Uri, State, Local, Remote) 9 | import LSEQ 10 | import LSEQ.Types as LSEQ 11 | import Store 12 | import Set 13 | 14 | 15 | (:=) = 16 | Dec.field 17 | 18 | 19 | decodeUri : Decoder Uri 20 | decodeUri = 21 | Dec.string 22 | 23 | 24 | decodeAppReceive : Decoder Msg 25 | decodeAppReceive = 26 | Dec.index 0 decodeUri 27 | |> Dec.andThen 28 | (\app -> 29 | Dec.index 1 <| 30 | Dec.oneOf 31 | [ decodeQuery |> Dec.map (LocalQuery app) 32 | , decodeLocalOperations |> Dec.map (Save app) 33 | ] 34 | ) 35 | 36 | 37 | decodeRemoteQuery : Peer -> Decoder Msg 38 | decodeRemoteQuery peer = 39 | Dec.oneOf 40 | [ Dec.field "q" decodeQuery 41 | |> Dec.map (RemoteQuery peer) 42 | , Dec.field "r" decodeQuery 43 | |> Dec.map (ReQuery peer) 44 | ] 45 | 46 | 47 | decodeQuery : Decoder Query 48 | decodeQuery = 49 | Dec.map3 (,,) 50 | (Dec.index 0 Dec.string) 51 | (Dec.index 1 Dec.string) 52 | (Dec.index 2 Dec.string) 53 | 54 | 55 | {-| 56 | Decodes data coming from other peers 57 | -} 58 | decodeReceive : Decoder Msg 59 | decodeReceive = 60 | Dec.index 0 decodeUri 61 | |> Dec.andThen 62 | (\peer -> 63 | Dec.index 1 <| 64 | Dec.oneOf 65 | [ decodeRemoteOperations 66 | |> Dec.map (Load peer) 67 | , decodeStates 68 | |> Dec.map (Subscriber peer) 69 | , decodeRemoteQuery peer 70 | , decodeMeta 71 | |> Dec.map (ReceiveMeta peer) 72 | , Dec.bool 73 | |> Dec.andThen 74 | (\online -> 75 | if online then 76 | Dec.succeed (AddPeer peer) 77 | else 78 | Dec.succeed (ClosePeer peer) 79 | ) 80 | ] 81 | ) 82 | 83 | 84 | decodeMeta : Decoder Meta 85 | decodeMeta = 86 | Dec.map2 (,) 87 | (Dec.index 0 decodeUri) 88 | (Dec.index 1 <| Dec.map Set.fromList <| Dec.list decodeUri) 89 | |> Dec.list 90 | |> Dec.map Dict.fromList 91 | 92 | 93 | {-| 94 | Decode localOperations from an app to be saved. 95 | -} 96 | decodeAppSave : Decoder ( Uri, LocalOperations ) 97 | decodeAppSave = 98 | Dec.map2 (,) 99 | (Dec.index 0 decodeUri) 100 | (Dec.index 1 decodeLocalOperations) 101 | 102 | 103 | {-| 104 | Decode the uri of an app, to be registered. 105 | -} 106 | decodeApp : Decoder Uri 107 | decodeApp = 108 | decodeUri 109 | 110 | 111 | decodeSubscribed : Decoder Key 112 | decodeSubscribed = 113 | Dec.field "subscribed" decodeKey 114 | 115 | 116 | decodeIndexSubscribed : Decoder Key 117 | decodeIndexSubscribed = 118 | Dec.field "indexSubscribed" decodeKey 119 | 120 | 121 | decodeStates : Decoder States 122 | decodeStates = 123 | Store.decode decodeUri decodeUri decodeState 124 | 125 | 126 | decodeSubscriber : Decoder ( Key, State ) 127 | decodeSubscriber = 128 | Dec.map2 (,) 129 | (Dec.field "key" decodeKey) 130 | (Dec.field "state" decodeState) 131 | 132 | 133 | decodeIndexSubscriber : Decoder Key 134 | decodeIndexSubscriber = 135 | (Dec.field "index" decodeKey) 136 | 137 | 138 | decodeKey : Decoder Key 139 | decodeKey = 140 | Dec.map2 (,) 141 | (Dec.index 0 decodeUri) 142 | (Dec.index 1 decodeUri) 143 | 144 | 145 | decodeLocalOperations : Decoder LocalOperations 146 | decodeLocalOperations = 147 | Store.decode decodeUri decodeUri decodeCharOrRefOps 148 | 149 | 150 | decodeCharOrRefOps : Decoder CharOrRefOps 151 | decodeCharOrRefOps = 152 | Dec.oneOf 153 | [ Dec.map RefOps <| Dec.field "ref" <| Dec.list (decodeLocal decodeUri) 154 | , Dec.map CharOps <| Dec.field "literal" <| Dec.list (decodeLocal decodeChar) 155 | ] 156 | 157 | 158 | decodeCharOrRefRemoteOps : Decoder ( CharOrRefRemoteOps, State ) 159 | decodeCharOrRefRemoteOps = 160 | Dec.map2 (,) 161 | (Dec.index 0 162 | (Dec.oneOf 163 | [ Dec.map RefRemoteOps <| Dec.field "ref" <| Dec.list (decodeRemote decodeUri) 164 | , Dec.map CharRemoteOps <| Dec.field "literal" <| Dec.list (decodeRemote decodeChar) 165 | ] 166 | ) 167 | ) 168 | (Dec.index 1 decodeState) 169 | 170 | 171 | decodeLocal : Decoder a -> Decoder (Local a) 172 | decodeLocal decoder = 173 | Dec.map2 (,) 174 | (Dec.index 0 <| 175 | Dec.map2 (,) 176 | (Dec.index 0 decodeUri) 177 | (Dec.index 1 Dec.int) 178 | ) 179 | (Dec.index 1 (decodeOp decoder)) 180 | 181 | 182 | decodeRemoteOperations : Decoder RemoteOperations 183 | decodeRemoteOperations = 184 | Store.decode decodeUri decodeUri decodeCharOrRefRemoteOps 185 | 186 | 187 | decodeRemote : Decoder a -> Decoder (Remote a) 188 | decodeRemote decoder = 189 | Dec.map3 (\a b c -> ( a, ( b, c ) )) 190 | (Dec.index 0 LSEQ.decodeID) 191 | (Dec.index 1 decodeUri) 192 | (Dec.index 2 (decodeOp decoder)) 193 | 194 | 195 | decodeState : Decoder State 196 | decodeState = 197 | Dec.int 198 | 199 | 200 | decodeOp : Decoder a -> Decoder (LSEQ.Op a) 201 | decodeOp decoder = 202 | Dec.oneOf 203 | [ decodeInsert decoder 204 | , decodeRemove decoder 205 | ] 206 | 207 | 208 | decodeInsert : Decoder a -> Decoder (LSEQ.Op a) 209 | decodeInsert decoder = 210 | "i" 211 | := decoder 212 | |> Dec.map LSEQ.Insert 213 | 214 | 215 | decodeRemove : Decoder a -> Decoder (LSEQ.Op a) 216 | decodeRemove _ = 217 | Dec.string 218 | |> Dec.andThen 219 | (\s -> 220 | if s == "r" then 221 | Dec.succeed LSEQ.Remove 222 | else 223 | Dec.fail "unknown op" 224 | ) 225 | 226 | 227 | 228 | {- 229 | decodeChangedEntities : Decoder ChangedEntities 230 | decodeChangedEntities = 231 | Store.decode decodeUri decodeUri decodeChangedObject 232 | 233 | 234 | decodeChangedObject : Decoder ChangedObject 235 | decodeChangedObject = 236 | Dec.map2 (,) 237 | (Dec.index 0 <| LSEQ.decodeLayer Dec.string) 238 | (Dec.index 1 <| Dec.list decodeRemote) 239 | -} 240 | 241 | 242 | decodePredicate : Decoder ( Predicate, List String ) 243 | decodePredicate = 244 | Dec.map2 (,) 245 | (Dec.index 0 decodeUri) 246 | (Dec.index 1 <| Dec.list Dec.string) 247 | 248 | 249 | decodeRequest : (Uri -> Key -> msg) -> (Uri -> Key -> msg) -> Decoder msg 250 | decodeRequest requestMsg requestIndexMsg = 251 | Dec.index 0 decodeUri 252 | |> Dec.andThen 253 | (\uri -> 254 | Dec.index 1 255 | (Dec.oneOf 256 | [ Dec.field "r" decodeKey |> Dec.map (requestMsg uri) 257 | , Dec.field "i" decodeKey |> Dec.map (requestIndexMsg uri) 258 | ] 259 | ) 260 | ) 261 | 262 | 263 | decodeEntities : Decoder Entities 264 | decodeEntities = 265 | Store.decode decodeUri decodeUri decodeObject 266 | 267 | 268 | decodeObject : Decoder Object 269 | decodeObject = 270 | Dec.oneOf 271 | [ Dec.map Ref <| Dec.field "ref" <| Dec.list <| LSEQ.decodeEntry decodeUri 272 | , Dec.map Literal <| Dec.field "literal" <| Dec.list <| LSEQ.decodeEntry decodeChar 273 | ] 274 | 275 | 276 | decodeChar : Decoder Char 277 | decodeChar = 278 | Dec.string 279 | |> Dec.andThen 280 | (\str -> 281 | case String.toList str |> List.head of 282 | Nothing -> 283 | Dec.fail "no char" 284 | 285 | Just c -> 286 | Dec.succeed c 287 | ) 288 | 289 | 290 | decodeRemoteOperationsAndState : Decoder ( RemoteOperations, State ) 291 | decodeRemoteOperationsAndState = 292 | Dec.map2 (,) 293 | (Dec.index 0 decodeRemoteOperations) 294 | (Dec.index 1 decodeState) 295 | -------------------------------------------------------------------------------- /src/Bright/Encoder.elm: -------------------------------------------------------------------------------- 1 | module Bright.Encoder exposing (..) 2 | 3 | import Set exposing (Set) 4 | import Dict 5 | import Bright.Model exposing (..) 6 | import Bright.DB exposing (Entities, Object(..), Query, LocalOperations, RemoteOperations, CharOrRefRemoteOps(..), CharOrRefOps(..), Meta, States) 7 | import Graph exposing (Subject, Predicate, Uri, Local, Remote, State) 8 | import Json.Encode as Enc 9 | import LSEQ.Types as LSEQ 10 | import LSEQ as LSEQ 11 | import Store 12 | 13 | 14 | encodeStates : States -> Enc.Value 15 | encodeStates = 16 | Store.encode encodeUri encodeUri encodeState 17 | 18 | 19 | encodeMeta : Meta -> Enc.Value 20 | encodeMeta meta = 21 | Dict.toList meta 22 | |> List.map 23 | (\( s, ps ) -> 24 | Enc.list 25 | [ encodeUri s 26 | , encodePredicateSet ps 27 | ] 28 | ) 29 | |> Enc.list 30 | 31 | 32 | encodePredicateSet : Set Predicate -> Enc.Value 33 | encodePredicateSet = 34 | Set.toList >> List.map encodeUri >> Enc.list 35 | 36 | 37 | encodeQuery : Query -> Enc.Value 38 | encodeQuery query = 39 | Enc.object 40 | [ ( "q", encodeQuery_ query ) 41 | ] 42 | 43 | 44 | encodeQuery_ : Query -> Enc.Value 45 | encodeQuery_ ( s, p, o ) = 46 | Enc.list [ Enc.string s, Enc.string p, Enc.string o ] 47 | 48 | 49 | encodeRequery : Query -> Enc.Value 50 | encodeRequery query = 51 | Enc.object 52 | [ ( "r", encodeQuery_ query ) 53 | ] 54 | 55 | 56 | encodeEntities : Entities -> Enc.Value 57 | encodeEntities = 58 | Store.encode encodeUri encodeUri encodeObject 59 | 60 | 61 | encodeObject : Object -> Enc.Value 62 | encodeObject object = 63 | case object of 64 | Ref list -> 65 | Enc.object 66 | [ ( "ref", Enc.list <| List.map (LSEQ.encodeEntry Enc.string) list ) 67 | ] 68 | 69 | Literal list -> 70 | Enc.object 71 | [ ( "literal", Enc.list <| List.map (LSEQ.encodeEntry encodeChar) list ) 72 | ] 73 | 74 | 75 | encodeChar : Char -> Enc.Value 76 | encodeChar = 77 | String.fromChar >> Enc.string 78 | 79 | 80 | encodeLocalOperations : LocalOperations -> Enc.Value 81 | encodeLocalOperations = 82 | Store.encode encodeUri encodeUri encodeCharOrRefOps 83 | 84 | 85 | encodeRemoteOperations : RemoteOperations -> Enc.Value 86 | encodeRemoteOperations = 87 | Store.encode encodeUri encodeUri encodeCharOrRefRemoteOps 88 | 89 | 90 | encodeCharOrRefOps : CharOrRefOps -> Enc.Value 91 | encodeCharOrRefOps ops = 92 | case ops of 93 | CharOps list -> 94 | Enc.object 95 | [ ( "literal", (Enc.list << List.map (encodeLocal encodeChar)) list ) 96 | ] 97 | 98 | RefOps list -> 99 | Enc.object 100 | [ ( "ref", (Enc.list << List.map (encodeLocal encodeUri)) list ) 101 | ] 102 | 103 | 104 | encodeCharOrRefRemoteOps : ( CharOrRefRemoteOps, State ) -> Enc.Value 105 | encodeCharOrRefRemoteOps ( ops, state ) = 106 | Enc.list 107 | [ case ops of 108 | CharRemoteOps list -> 109 | Enc.object 110 | [ ( "literal" 111 | , Enc.list <| List.map (encodeRemote encodeChar) list 112 | ) 113 | ] 114 | 115 | RefRemoteOps list -> 116 | Enc.object 117 | [ ( "ref" 118 | , Enc.list <| List.map (encodeRemote encodeUri) list 119 | ) 120 | ] 121 | , encodeState state 122 | ] 123 | 124 | 125 | encodeLocal : (a -> Enc.Value) -> Local a -> Enc.Value 126 | encodeLocal encoder ( ( target, pos ), op ) = 127 | Enc.list 128 | [ Enc.list [ encodeUri target, Enc.int pos ] 129 | , encodeOp op encoder 130 | ] 131 | 132 | 133 | 134 | {- 135 | encodeLocal : Local -> Enc.Value 136 | encodeLocal ( pos, concurrents ) = 137 | Enc.list 138 | [ Enc.int pos 139 | , concurrents 140 | |> List.map 141 | (\( target, op ) -> 142 | Enc.list 143 | [ encodeUri target 144 | , encodeOp op 145 | ] 146 | ) 147 | |> Enc.list 148 | ] 149 | -} 150 | 151 | 152 | encodeUri : Uri -> Enc.Value 153 | encodeUri = 154 | Enc.string 155 | 156 | 157 | encodeSubscribed : ( Subject, Predicate ) -> Enc.Value 158 | encodeSubscribed key = 159 | Enc.object 160 | [ ( "subscribed", encodeKey key ) 161 | ] 162 | 163 | 164 | encodeIndexSubscribed : ( Subject, Predicate ) -> Enc.Value 165 | encodeIndexSubscribed key = 166 | Enc.object 167 | [ ( "indexSubscribed", encodeKey key ) 168 | ] 169 | 170 | 171 | encodeKey : ( Subject, Predicate ) -> Enc.Value 172 | encodeKey ( s, p ) = 173 | Enc.list 174 | [ encodeUri s 175 | , encodeUri p 176 | ] 177 | 178 | 179 | encodePeer : Uri -> Enc.Value -> Enc.Value 180 | encodePeer peer body = 181 | Enc.list 182 | [ encodeUri peer 183 | , body 184 | ] 185 | 186 | 187 | encodeApp = 188 | encodePeer 189 | 190 | 191 | encodeSubscription : Key -> Int -> Enc.Value 192 | encodeSubscription key state = 193 | Enc.object 194 | [ ( "key", encodeKey key ) 195 | , ( "state", Enc.int state ) 196 | ] 197 | 198 | 199 | encodeIndexSubscription : Key -> Enc.Value 200 | encodeIndexSubscription key = 201 | Enc.object 202 | [ ( "index", encodeKey key ) 203 | ] 204 | 205 | 206 | encodeState : State -> Enc.Value 207 | encodeState = 208 | Enc.int 209 | 210 | 211 | encodeOp : LSEQ.Op a -> (a -> Enc.Value) -> Enc.Value 212 | encodeOp op encoder = 213 | case op of 214 | LSEQ.Insert s -> 215 | encoder s 216 | |> (,) "i" 217 | |> (\x -> [ x ]) 218 | |> Enc.object 219 | 220 | LSEQ.Remove -> 221 | Enc.string "r" 222 | 223 | 224 | encodeRemote : (a -> Enc.Value) -> Remote a -> Enc.Value 225 | encodeRemote encoder ( id, ( origin, op ) ) = 226 | Enc.list 227 | [ LSEQ.encodeID id 228 | , encodeUri origin 229 | , encodeOp op encoder 230 | ] 231 | -------------------------------------------------------------------------------- /src/Bright/IO.elm: -------------------------------------------------------------------------------- 1 | module Bright.IO exposing (..) 2 | 3 | import Json.Decode as Dec 4 | import Json.Encode as Enc 5 | import Dict 6 | import Bright.Ports 7 | import Bright.Model exposing (..) 8 | import Bright.Decoder exposing (..) 9 | import Bright.Encoder exposing (..) 10 | import Graph exposing (Subject, Predicate, Uri) 11 | import Bright.DB exposing (wildcard, Query, Entities, LocalOperations) 12 | import Store 13 | 14 | 15 | load : (Entities -> msg) -> Sub msg 16 | load tag = 17 | Bright.Ports.load 18 | (Dec.decodeValue decodeEntities 19 | >> Result.withDefault Store.empty 20 | >> tag 21 | ) 22 | 23 | 24 | save : LocalOperations -> Cmd msg 25 | save = 26 | encodeLocalOperations >> Debug.log "save" >> Bright.Ports.save 27 | 28 | 29 | query : Query -> Cmd msg 30 | query = 31 | encodeQuery_ >> Bright.Ports.localQuery 32 | -------------------------------------------------------------------------------- /src/Bright/Model.elm: -------------------------------------------------------------------------------- 1 | module Bright.Model exposing (..) 2 | 3 | import Dict exposing (Dict) 4 | import Random exposing (Seed) 5 | import Set exposing (Set) 6 | import Maybe.Extra exposing (join) 7 | import List.Extra 8 | import Array.Hamt as Array exposing (Array) 9 | import Bright.Uris exposing (..) 10 | import LSEQ exposing (LSEQ) 11 | import LSEQ.Types as LSEQ 12 | import Store 13 | import Bright.DB exposing (Entities, Query, wildcard) 14 | import Graph exposing (Subject, Predicate, Graph, Uri, State, Remote, Local) 15 | import Tuple exposing (mapFirst) 16 | 17 | 18 | userSpace = 19 | "device" 20 | 21 | 22 | {-| 23 | Entities is derived from History 24 | -} 25 | type alias Model = 26 | { namespace : Uri 27 | , entities : Entities 28 | , db : Graph 29 | , peers : Set Uri 30 | , subscribers : Subscribers 31 | , subscribed : Subscribed 32 | , localQueries : Queries 33 | , remoteQueries : Queries 34 | , seed : Seed 35 | } 36 | 37 | 38 | {-| 39 | Stores queries in a hierarchy of dicts: Subject > Predicate > (Object, Set App) 40 | -} 41 | type alias Queries = 42 | Store (Dict Uri (Set Uri)) 43 | 44 | 45 | type alias App = 46 | Uri 47 | 48 | 49 | type alias Peer = 50 | Uri 51 | 52 | 53 | type alias Store a = 54 | Store.Store Subject Predicate a 55 | 56 | 57 | {-| 58 | Subscriptions to other peers 59 | key is the (subject, predicate) uri of the entity 60 | -} 61 | type alias Subscribed = 62 | Store (Dict Uri State) 63 | 64 | 65 | {-| 66 | -} 67 | type alias Subscribers = 68 | Dict Peer (Store ()) 69 | 70 | 71 | type alias Subscription = 72 | ( Uri, Key, Int ) 73 | 74 | 75 | type alias Key = 76 | ( Subject, Predicate ) 77 | 78 | 79 | type Operation 80 | = Insert String 81 | | Remove 82 | 83 | 84 | type alias Flags = 85 | { namespace : Uri 86 | , seed : Int 87 | } 88 | 89 | 90 | init : Flags -> ( Model, Cmd msg ) 91 | init flags = 92 | ( initModel flags 93 | , Cmd.none 94 | ) 95 | 96 | 97 | initModel : Flags -> Model 98 | initModel { namespace, seed } = 99 | Model namespace Store.empty Graph.empty Set.empty Dict.empty Store.empty Store.empty Store.empty <| Random.initialSeed seed 100 | 101 | 102 | initEntities : Entities 103 | initEntities = 104 | Store.empty 105 | 106 | 107 | currentState : Model -> Uri -> Key -> State 108 | currentState model peer ( s, p ) = 109 | Store.getObject s p model.subscribed 110 | |> Debug.log ("currentState subscribed " ++ s ++ ", " ++ p) 111 | |> Maybe.map (Dict.get peer) 112 | |> Maybe.Extra.join 113 | |> Maybe.withDefault -1 114 | 115 | 116 | getSubscribers : Model -> Key -> ( Set Uri, Set Uri ) 117 | getSubscribers model ( subject, predicate ) = 118 | let 119 | ( allLocal, allRemote ) = 120 | ( Set.empty, Set.empty ) 121 | 122 | ( specLocal, specRemote ) = 123 | ( Set.empty, Set.empty ) 124 | in 125 | ( Set.union allLocal specLocal 126 | , Set.union allRemote specRemote 127 | ) 128 | 129 | 130 | getSubscriptions : Model -> Key -> Dict Uri State 131 | getSubscriptions model ( subject, predicate ) = 132 | let 133 | all = 134 | Store.getObject subject wildcard model.subscribed 135 | |> Maybe.withDefault Dict.empty 136 | 137 | spec = 138 | Store.getObject subject predicate model.subscribed 139 | |> Maybe.withDefault Dict.empty 140 | in 141 | Dict.union all spec 142 | 143 | 144 | mapOp : LSEQ.Op String -> Operation 145 | mapOp op = 146 | case op of 147 | LSEQ.Insert str -> 148 | Insert str 149 | 150 | LSEQ.Remove -> 151 | Remove 152 | 153 | 154 | getUrisForQuery : Query -> Queries -> Set Uri 155 | getUrisForQuery ( s, p, o ) queries = 156 | Store.getObject s p queries 157 | |> Maybe.withDefault Dict.empty 158 | |> Dict.get o 159 | |> Maybe.withDefault Set.empty 160 | 161 | 162 | {-| 163 | Stores a query and associates it with an app. Returns the updated queries and a flag whether there where NO changes. 164 | -} 165 | storeQuery : App -> Query -> Queries -> ( Queries, Bool ) 166 | storeQuery app ( s, p, o ) queries = 167 | Store.getObject s p queries 168 | |> Maybe.withDefault Dict.empty 169 | |> (\dict -> 170 | Dict.get o dict 171 | |> Maybe.withDefault Set.empty 172 | |> (\set -> 173 | ( Dict.insert o (Set.insert app set) dict 174 | , Set.member app set 175 | ) 176 | ) 177 | ) 178 | |> mapFirst (\dict -> Store.insertObject s p dict queries) 179 | 180 | 181 | flattenQueries : Queries -> List Query 182 | flattenQueries = 183 | Store.foldl 184 | (\s p dict flat -> 185 | Dict.foldl 186 | (\o _ flat -> 187 | ( s, p, o ) :: flat 188 | ) 189 | flat 190 | dict 191 | ) 192 | [] 193 | -------------------------------------------------------------------------------- /src/Bright/Ports.elm: -------------------------------------------------------------------------------- 1 | port module Bright.Ports exposing (..) 2 | 3 | import Task exposing (Task) 4 | import Graph exposing (Uri, Predicate) 5 | import Bright.DB exposing (Object) 6 | import Json.Decode as Dec 7 | import Json.Encode as Enc 8 | 9 | 10 | port appLoad : Enc.Value -> Cmd msg 11 | 12 | 13 | {-| send remoteOperations to another peer 14 | -} 15 | port send : Enc.Value -> Cmd msg 16 | 17 | 18 | {-| receive subscriptions from other peers 19 | receive remoteOperations 20 | -} 21 | port receive : (Dec.Value -> msg) -> Sub msg 22 | 23 | 24 | port appSave : (Dec.Value -> msg) -> Sub msg 25 | 26 | 27 | {-| save app changeset to bright 28 | -} 29 | port save : Enc.Value -> Cmd msg 30 | 31 | 32 | {-| load bright changes into app 33 | -} 34 | port load : (Dec.Value -> msg) -> Sub msg 35 | 36 | 37 | port localQuery : Enc.Value -> Cmd msg 38 | 39 | 40 | port appReceive : (Dec.Value -> msg) -> Sub msg 41 | -------------------------------------------------------------------------------- /src/Bright/Sub.elm: -------------------------------------------------------------------------------- 1 | module Bright.Sub exposing (subscriptions) 2 | 3 | import Json.Decode as Dec exposing (Decoder) 4 | import Bright.Model exposing (..) 5 | import Bright.Decoder exposing (..) 6 | import Bright.Ports 7 | import Bright.Update exposing (..) 8 | 9 | 10 | subscriptions : Model -> Sub Msg 11 | subscriptions model = 12 | Sub.batch 13 | [ receive 14 | , appReceive 15 | ] 16 | 17 | 18 | receive : Sub Msg 19 | receive = 20 | Bright.Ports.receive 21 | (Dec.decodeValue decodeReceive 22 | >> Result.withDefault (Error "could not decode data") 23 | ) 24 | 25 | 26 | appReceive : Sub Msg 27 | appReceive = 28 | Bright.Ports.appReceive 29 | (Dec.decodeValue decodeAppReceive 30 | >> Debug.log "result" 31 | >> Result.withDefault (Error "could not decode appReceive") 32 | ) 33 | -------------------------------------------------------------------------------- /src/Bright/Update.elm: -------------------------------------------------------------------------------- 1 | module Bright.Update exposing (..) 2 | 3 | import Dict exposing (Dict) 4 | import Set exposing (Set) 5 | import Task 6 | import Tuple exposing (first, second, mapSecond) 7 | import Array.Hamt as Array exposing (Array) 8 | import List.Extra 9 | import Bright.Model exposing (..) 10 | import Bright.Uris as U 11 | import Bright.Cmds 12 | import Bright.Ports 13 | import Bright.DB as DB exposing (Entities, Query, CharOrRefRemoteOps(..), CharOrRefOps(..), RemoteOperations, LocalOperations, wildcard, Meta, States) 14 | import Bright.Encoder exposing (..) 15 | import Tuple exposing (second, mapFirst) 16 | import LSEQ.Types as LSEQ 17 | import LSEQ 18 | import Maybe.Extra 19 | import Store 20 | import Graph exposing (Uri, Subject, Predicate, Graph, State, Remote) 21 | 22 | 23 | type Msg 24 | = Save App LocalOperations 25 | | Load Uri RemoteOperations 26 | | Error String 27 | | AddPeer Uri 28 | | ClosePeer Uri 29 | | LocalQuery Uri Query 30 | | RemoteQuery Peer Query 31 | | ReQuery Peer Query 32 | | Subscriber Peer States 33 | | ReceiveMeta Peer Meta 34 | | NoOp 35 | 36 | 37 | update : Msg -> Model -> ( Model, Cmd Msg ) 38 | update msg model = 39 | case Debug.log "brightMsg" msg of 40 | NoOp -> 41 | ( model, Cmd.none ) 42 | 43 | Save app localOps -> 44 | if Store.isEmpty localOps then 45 | ( model, Cmd.none ) 46 | else 47 | let 48 | ( db, remoteOps ) = 49 | filterDisallowed app localOps 50 | |> DB.mutate model.db app 51 | 52 | model_ = 53 | { model 54 | | db = db 55 | } 56 | in 57 | ( model_ 58 | , notify model_ app remoteOps 59 | ) 60 | 61 | Error str -> 62 | ( model, Cmd.none ) 63 | 64 | Load peer remoteOps -> 65 | if Store.isEmpty remoteOps then 66 | ( model, Cmd.none ) 67 | else 68 | let 69 | ( subscribed, complete, incomplete ) = 70 | Store.foldl 71 | (\s p ( ops, state ) ( subscribed, complete, incomplete ) -> 72 | case Store.getObject s p subscribed of 73 | Just dict -> 74 | case Dict.get peer dict of 75 | Just oldState -> 76 | if oldState + (DB.opsLength ops) < state then 77 | ( subscribed 78 | , complete 79 | , Store.insertObject s p oldState incomplete 80 | ) 81 | else 82 | ( Store.insertObject s p (Dict.insert peer state dict) subscribed 83 | , Store.insertObject s p ( ops, state ) complete 84 | , incomplete 85 | ) 86 | 87 | Nothing -> 88 | ( Store.insertObject s p (Dict.singleton peer state) subscribed 89 | , Store.insertObject s p ( ops, state ) complete 90 | , incomplete 91 | ) 92 | 93 | Nothing -> 94 | ( Store.insertObject s p (Dict.singleton peer state) subscribed 95 | , Store.insertObject s p ( ops, state ) complete 96 | , incomplete 97 | ) 98 | ) 99 | ( model.subscribed, Store.empty, Store.empty ) 100 | remoteOps 101 | 102 | ( db, remoteOps_ ) = 103 | DB.mutateRemote model.db complete 104 | 105 | model_ = 106 | { model 107 | | subscribed = subscribed 108 | , db = db 109 | } 110 | in 111 | ( model_ 112 | , Cmd.batch 113 | [ notify model_ peer remoteOps_ 114 | , Bright.Cmds.subscribe peer incomplete 115 | ] 116 | ) 117 | 118 | AddPeer peer -> 119 | let 120 | newModel = 121 | { model 122 | | peers = Set.insert peer model.peers 123 | } 124 | in 125 | ( newModel 126 | , flattenQueries model.localQueries 127 | |> Debug.log "flattenQueries" 128 | |> List.map (Bright.Cmds.queryMeta (Set.toList newModel.peers)) 129 | |> Cmd.batch 130 | ) 131 | 132 | ClosePeer peer -> 133 | ( { model 134 | | peers = Set.remove peer model.peers 135 | } 136 | , Cmd.none 137 | ) 138 | 139 | LocalQuery app query -> 140 | let 141 | ( queries, unchanged ) = 142 | storeQuery app query model.localQueries 143 | |> Debug.log "localQueries" 144 | in 145 | if unchanged then 146 | ( model, Cmd.none ) 147 | else 148 | ( { model 149 | | localQueries = queries 150 | } 151 | , Cmd.batch 152 | [ DB.query model.db query 153 | |> Bright.Cmds.localResult app 154 | , Bright.Cmds.queryMeta (Set.toList model.peers) query 155 | ] 156 | ) 157 | 158 | RemoteQuery peer query -> 159 | Bright.Cmds.requeryMeta peer query 160 | |> remoteQuery model peer query 161 | 162 | ReQuery peer query -> 163 | remoteQuery model peer query Cmd.none 164 | 165 | ReceiveMeta peer meta -> 166 | ( model 167 | , Bright.Cmds.subscribeByMeta model peer meta 168 | ) 169 | 170 | Subscriber peer states -> 171 | -- this action actually subscribes for updates AND triggers getPast 172 | -- could be separated! 173 | let 174 | result = 175 | DB.getPast model.db states 176 | 177 | subscribers = 178 | Store.foldl 179 | (\s p _ subscribers -> 180 | Dict.update peer 181 | (Maybe.map (Store.insertObject s p ())) 182 | subscribers 183 | ) 184 | model.subscribers 185 | states 186 | in 187 | ( { model 188 | | subscribers = subscribers 189 | } 190 | , if Store.isEmpty result then 191 | Cmd.none 192 | else 193 | Bright.Cmds.remoteResult peer result 194 | ) 195 | 196 | 197 | remoteQuery : Model -> Peer -> Query -> Cmd Msg -> ( Model, Cmd Msg ) 198 | remoteQuery model peer query requery = 199 | let 200 | ( queries, unchanged ) = 201 | storeQuery peer query model.remoteQueries 202 | |> Debug.log "remoteQueries" 203 | in 204 | let 205 | current = 206 | getUrisForQuery query model.remoteQueries 207 | 208 | meta = 209 | DB.queryMeta model.db query 210 | 211 | sendMeta = 212 | if Dict.isEmpty meta then 213 | Cmd.none 214 | else 215 | Bright.Cmds.sendMeta peer meta 216 | in 217 | ( { model 218 | | remoteQueries = queries 219 | } 220 | , Cmd.batch 221 | [ sendMeta 222 | , requery 223 | ] 224 | ) 225 | 226 | 227 | notify : Model -> Uri -> RemoteOperations -> Cmd Msg 228 | notify model origin remoteOps = 229 | let 230 | appsData = 231 | affectedQueries model.localQueries remoteOps 232 | |> Debug.log "affectedQueries" 233 | |> List.map 234 | (\( query, apps ) -> 235 | DB.query model.db query 236 | |> (\entities -> 237 | Store.filter 238 | (\s _ -> 239 | Store.toDicts remoteOps 240 | |> Dict.member s 241 | ) 242 | entities 243 | |> (,) (Set.remove origin apps) 244 | ) 245 | ) 246 | 247 | metaData = 248 | affectedQueries model.remoteQueries remoteOps 249 | |> Debug.log "affectedQueriesRemote" 250 | |> List.map 251 | (\( query, peers ) -> 252 | DB.queryMeta model.db query 253 | |> (\meta -> 254 | Dict.filter 255 | (\s _ -> 256 | Store.toDicts remoteOps 257 | |> Dict.member s 258 | ) 259 | (Debug.log "meta" meta) 260 | |> (,) (Set.remove origin peers) 261 | ) 262 | ) 263 | 264 | remoteResultCmds = 265 | model.subscribers 266 | |> Dict.map 267 | (\peer subs -> 268 | Store.map2 269 | (\s p result () -> result) 270 | remoteOps 271 | subs 272 | |> Bright.Cmds.remoteResult peer 273 | ) 274 | |> Dict.values 275 | in 276 | List.map notifyApps appsData 277 | ++ List.map notifyPeers metaData 278 | ++ remoteResultCmds 279 | |> Cmd.batch 280 | 281 | 282 | notifyApps : ( Set App, Entities ) -> Cmd Msg 283 | notifyApps ( apps, entities ) = 284 | Set.toList apps 285 | |> List.map (\app -> Bright.Cmds.localResult app entities) 286 | |> Cmd.batch 287 | 288 | 289 | notifyPeers : ( Set Peer, Meta ) -> Cmd Msg 290 | notifyPeers ( peers, meta ) = 291 | Set.toList peers 292 | |> List.map (\peer -> Bright.Cmds.sendMeta peer meta) 293 | |> Cmd.batch 294 | 295 | 296 | affectedQueries : Queries -> RemoteOperations -> List ( Query, Set Uri ) 297 | affectedQueries queries remoteOps = 298 | let 299 | forQuery query = 300 | let 301 | set = 302 | getUrisForQuery query queries 303 | in 304 | if Set.isEmpty set then 305 | [] 306 | else 307 | [ ( query, set ) ] 308 | 309 | opsToQueries s p ops = 310 | case ops of 311 | CharRemoteOps _ -> 312 | [] 313 | 314 | RefRemoteOps ops -> 315 | List.map 316 | (\( _, ( _, op ) ) -> 317 | case op of 318 | LSEQ.Insert v -> 319 | (forQuery ( wildcard, p, v )) 320 | ++ (forQuery ( s, p, v )) 321 | 322 | LSEQ.Remove -> 323 | [] 324 | ) 325 | ops 326 | |> List.concat 327 | in 328 | remoteOps 329 | |> Store.toDicts 330 | |> Dict.foldl 331 | (\s entity result -> 332 | Dict.foldl 333 | (\p ( ops, _ ) result -> 334 | (forQuery ( s, p, wildcard )) 335 | ++ (opsToQueries s p ops) 336 | ++ result 337 | ) 338 | ((forQuery ( s, wildcard, wildcard )) 339 | ++ (forQuery ( wildcard, wildcard, wildcard )) 340 | ++ result 341 | ) 342 | entity 343 | ) 344 | [] 345 | 346 | 347 | filterDisallowed : Uri -> LocalOperations -> LocalOperations 348 | filterDisallowed app = 349 | Store.filter (\s _ -> String.startsWith app s || String.startsWith userSpace s) 350 | -------------------------------------------------------------------------------- /src/Bright/Uris.elm: -------------------------------------------------------------------------------- 1 | module Bright.Uris exposing (..) 2 | 3 | {-| 4 | @docs isA, range, nilUri, defaultTypeUri 5 | -} 6 | 7 | import Graph exposing (Uri) 8 | 9 | 10 | {-| 11 | -} 12 | isA : Uri 13 | isA = 14 | "http://rdfs/isA" 15 | 16 | 17 | {-| 18 | -} 19 | range : Uri 20 | range = 21 | "http://rdfs/contains" 22 | 23 | 24 | {-| 25 | -} 26 | nilUri : Uri 27 | nilUri = 28 | "http://nil" 29 | 30 | 31 | {-| 32 | -} 33 | defaultTypeUri : Uri 34 | defaultTypeUri = 35 | "http://thing" 36 | -------------------------------------------------------------------------------- /src/Bright/Util.elm: -------------------------------------------------------------------------------- 1 | module Bright.Util exposing (..) 2 | 3 | {-| 4 | @docs isUri, isSubscribed 5 | -} 6 | 7 | import String 8 | import Set 9 | import Dict 10 | import Array.Hamt as Array exposing (Array) 11 | import Bright.Uris 12 | import Bright.Model exposing (Model) 13 | import Graph exposing (Uri, Subject, Predicate, Local) 14 | import Store 15 | 16 | 17 | {-| 18 | -} 19 | isSubscribed : Model -> Uri -> Subject -> Predicate -> Bool 20 | isSubscribed model peer subject predicate = 21 | Store.getObject subject predicate model.subscribed 22 | |> Maybe.map (Dict.member peer) 23 | |> Maybe.withDefault False 24 | 25 | 26 | {-| 27 | -} 28 | isUri : String -> Bool 29 | isUri = 30 | String.startsWith "http" 31 | -------------------------------------------------------------------------------- /src/Bright/View.elm: -------------------------------------------------------------------------------- 1 | module Bright.View exposing (..) 2 | 3 | import Html exposing (text, ul, li, div, h3, h2) 4 | import Html.Attributes exposing (class) 5 | import Set 6 | 7 | 8 | view model = 9 | div 10 | [ class "connection" ] 11 | [ h2 [] [ text "Connection status" ] 12 | , h3 [] [ text <| "You are on " ++ model.namespace ] 13 | , h3 [] [ text "Online peer devices:" ] 14 | , peers model 15 | ] 16 | 17 | 18 | peers model = 19 | if Set.isEmpty model.peers then 20 | div 21 | [ class "note" ] 22 | [ text "Open this page on other devices too to get them connected!" 23 | , text " (you might need to refresh the page)" 24 | ] 25 | else 26 | ul 27 | [] 28 | <| 29 | List.map 30 | (\peer -> 31 | li 32 | [] 33 | [ text peer 34 | ] 35 | ) 36 | <| 37 | Set.toList model.peers 38 | -------------------------------------------------------------------------------- /src/Graph.elm: -------------------------------------------------------------------------------- 1 | module Graph exposing (..) 2 | 3 | {-| 4 | @docs State, Uri, Subject, Predicate, Graph, Node, Adjacency, LocalsOrRemotes, Local, Remote, empty, initNode, applyCharOps, applyRefOps, get 5 | -} 6 | 7 | import Dict exposing (Dict) 8 | import Set exposing (Set) 9 | import Tuple exposing (..) 10 | import LSEQ exposing (LSEQ) 11 | import LSEQ.Types as LSEQ 12 | 13 | 14 | {-| 15 | -} 16 | type alias State = 17 | Int 18 | 19 | 20 | {-| 21 | -} 22 | type alias Uri = 23 | String 24 | 25 | 26 | {-| 27 | -} 28 | type alias Subject = 29 | Uri 30 | 31 | 32 | {-| 33 | -} 34 | type alias Predicate = 35 | Uri 36 | 37 | 38 | {-| 39 | -} 40 | type alias Graph = 41 | Dict Subject Node 42 | 43 | 44 | {-| 45 | -} 46 | type alias Node = 47 | { id : Uri 48 | , incoming : Dict Predicate (Set Uri) 49 | , outgoing : Adjacency Uri 50 | , body : Adjacency Char 51 | } 52 | 53 | 54 | {-| 55 | -} 56 | type alias Adjacency a = 57 | Dict Predicate (LSEQ a) 58 | 59 | 60 | {-| 61 | -} 62 | type LocalsOrRemotes a 63 | = Locals (List (Local a)) 64 | | Remotes (List (Remote a)) 65 | 66 | 67 | {-| 68 | -} 69 | type alias Local a = 70 | ( ( Uri, Int ), LSEQ.Op a ) 71 | 72 | 73 | {-| 74 | -} 75 | type alias Remote a = 76 | LSEQ.HistoryEntry a 77 | 78 | 79 | {-| 80 | -} 81 | empty : Graph 82 | empty = 83 | Dict.empty 84 | 85 | 86 | {-| 87 | -} 88 | initNode : Subject -> Node 89 | initNode s = 90 | Node s Dict.empty Dict.empty Dict.empty 91 | 92 | 93 | {-| 94 | -} 95 | get : Uri -> Graph -> Maybe Node 96 | get uri graph = 97 | Dict.get uri graph 98 | 99 | 100 | {-| 101 | -} 102 | applyCharOps : Uri -> Subject -> Predicate -> LocalsOrRemotes Char -> Graph -> ( Graph, ( List (Remote Char), State ) ) 103 | applyCharOps origin s p ops graph = 104 | Dict.get s graph 105 | |> Maybe.withDefault (initNode s) 106 | |> (\node -> 107 | Dict.get p node.body 108 | |> Maybe.withDefault LSEQ.empty 109 | |> (case ops of 110 | Locals ops -> 111 | LSEQ.applyLocalOps origin ops 112 | 113 | Remotes ops -> 114 | LSEQ.applyRemoteOps ops 115 | ) 116 | |> (\( lseq, ops ) -> 117 | ( { node 118 | | body = 119 | Dict.insert p lseq node.body 120 | } 121 | , ( ops, LSEQ.currentState lseq ) 122 | ) 123 | ) 124 | ) 125 | |> mapFirst (\node -> Dict.insert s node graph) 126 | 127 | 128 | {-| 129 | -} 130 | applyRefOps : Uri -> Subject -> Predicate -> LocalsOrRemotes Uri -> Graph -> ( Graph, ( List (Remote Uri), State ) ) 131 | applyRefOps origin s p ops graph = 132 | Dict.get s graph 133 | |> Maybe.withDefault (initNode s) 134 | |> (\node -> 135 | Dict.get p node.outgoing 136 | |> Maybe.withDefault LSEQ.empty 137 | |> (case ops of 138 | Locals ops -> 139 | LSEQ.applyLocalOps origin ops 140 | 141 | Remotes ops -> 142 | LSEQ.applyRemoteOps ops 143 | ) 144 | |> (\( lseq, changes ) -> 145 | ( { node 146 | | outgoing = 147 | Dict.insert p lseq node.outgoing 148 | } 149 | , ( changes 150 | |> List.filterMap 151 | (\(( id, ( origin, op ) ) as change) -> 152 | case op of 153 | LSEQ.Remove -> 154 | LSEQ.resurrect lseq id 155 | |> Maybe.map ((,) change) 156 | 157 | LSEQ.Insert v -> 158 | Just ( change, v ) 159 | ) 160 | , LSEQ.currentState lseq 161 | ) 162 | ) 163 | ) 164 | ) 165 | |> (\( node, ( changes, state ) ) -> 166 | ( Dict.insert s node graph 167 | |> (\graph -> 168 | List.foldl 169 | (\( ( _, ( _, op ) ), ref ) graph -> 170 | Dict.get ref graph 171 | |> Maybe.withDefault (initNode ref) 172 | |> (\node -> 173 | Dict.get p node.incoming 174 | |> Maybe.withDefault Set.empty 175 | |> (case op of 176 | LSEQ.Insert _ -> 177 | Set.insert s 178 | 179 | LSEQ.Remove -> 180 | Set.remove s 181 | ) 182 | |> (\set -> 183 | { node 184 | | incoming = 185 | Dict.insert p set node.incoming 186 | } 187 | ) 188 | |> (\node -> Dict.insert ref node graph) 189 | ) 190 | ) 191 | graph 192 | changes 193 | ) 194 | , ( List.map first changes, state ) 195 | ) 196 | ) 197 | -------------------------------------------------------------------------------- /src/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | import Bright.Model 4 | import Bright.Update 5 | import Bright.Sub 6 | 7 | 8 | main = 9 | Platform.programWithFlags 10 | { init = Bright.Model.init 11 | , update = Bright.Update.update 12 | , subscriptions = Bright.Sub.subscriptions 13 | } 14 | -------------------------------------------------------------------------------- /src/Store.elm: -------------------------------------------------------------------------------- 1 | module Store exposing (..) 2 | 3 | {-| 4 | @docs Store, empty, get, getObject, insertObject, toDicts, encode, decode, map, map2, foldl, filter,fromDicts,fromList,isEmpty,union,update,values 5 | -} 6 | 7 | import Dict exposing (Dict) 8 | import Maybe.Extra exposing (join) 9 | import Json.Encode as Enc 10 | import Json.Decode as Dec exposing (Decoder) 11 | import Tuple exposing (mapSecond) 12 | 13 | 14 | {-| 15 | -} 16 | type Store comparable comparable o 17 | = Store (Dict comparable (Dict comparable o)) 18 | 19 | 20 | {-| 21 | -} 22 | empty : Store comparable comparable o 23 | empty = 24 | Store Dict.empty 25 | 26 | 27 | {-| 28 | -} 29 | get : comparable -> Store comparable comparable o -> Maybe (Dict comparable o) 30 | get s (Store st) = 31 | Dict.get s st 32 | 33 | 34 | {-| 35 | -} 36 | getObject : comparable -> comparable -> Store comparable comparable o -> Maybe o 37 | getObject s p (Store st) = 38 | Dict.get s st 39 | |> Maybe.map (Dict.get p) 40 | |> Maybe.Extra.join 41 | 42 | 43 | {-| 44 | -} 45 | insertObject : comparable -> comparable -> o -> Store comparable comparable o -> Store comparable comparable o 46 | insertObject s p o (Store st) = 47 | Dict.get s st 48 | |> Maybe.withDefault Dict.empty 49 | |> Dict.insert p o 50 | |> (\d -> Dict.insert s d st) 51 | |> Store 52 | 53 | 54 | {-| 55 | -} 56 | toDicts : Store comparable comparable o -> Dict comparable (Dict comparable o) 57 | toDicts (Store st) = 58 | st 59 | 60 | 61 | {-| 62 | -} 63 | encode : (comparable -> Enc.Value) -> (comparable -> Enc.Value) -> (o -> Enc.Value) -> Store comparable comparable o -> Enc.Value 64 | encode encodeS encodeP encodeO (Store st) = 65 | Dict.toList st 66 | |> List.map 67 | (\( s, p ) -> 68 | Enc.list 69 | [ encodeS s 70 | , Dict.toList p 71 | |> List.map 72 | (\( p, o ) -> 73 | Enc.list 74 | [ encodeP p 75 | , encodeO o 76 | ] 77 | ) 78 | |> Enc.list 79 | ] 80 | ) 81 | |> Enc.list 82 | 83 | 84 | {-| 85 | -} 86 | decode : Decoder comparable -> Decoder comparable -> Decoder o -> Decoder (Store comparable comparable o) 87 | decode decodeS decodeP decodeO = 88 | Dec.map (Store << Dict.fromList) <| 89 | Dec.list <| 90 | Dec.map2 (,) 91 | (Dec.index 0 decodeS) 92 | (Dec.index 1 <| 93 | Dec.map Dict.fromList <| 94 | Dec.list <| 95 | Dec.map2 (,) 96 | (Dec.index 0 decodeP) 97 | (Dec.index 1 decodeO) 98 | ) 99 | 100 | 101 | {-| 102 | -} 103 | map : (comparable -> comparable -> o -> u) -> Store comparable comparable o -> Store comparable comparable u 104 | map func (Store st) = 105 | Dict.map (\s p -> Dict.map (func s) p) st 106 | |> Store 107 | 108 | 109 | {-| 110 | -} 111 | map2 : (comparable -> comparable -> o1 -> o2 -> u) -> Store comparable comparable o1 -> Store comparable comparable o2 -> Store comparable comparable u 112 | map2 func st1 st2 = 113 | foldl 114 | (\s p o1 u -> 115 | case getObject s p st2 of 116 | Nothing -> 117 | u 118 | 119 | Just o2 -> 120 | func s p o1 o2 121 | |> (flip (insertObject s p)) u 122 | ) 123 | empty 124 | st1 125 | 126 | 127 | {-| 128 | -} 129 | isEmpty : Store comparable comparable o -> Bool 130 | isEmpty (Store st) = 131 | Dict.isEmpty st 132 | 133 | 134 | {-| 135 | -} 136 | foldl : (comparable -> comparable -> o -> u -> u) -> u -> Store comparable comparable o -> u 137 | foldl func acc (Store st) = 138 | st 139 | |> Dict.foldl 140 | (\s e acc -> 141 | Dict.foldl (func s) acc e 142 | ) 143 | acc 144 | 145 | 146 | {-| 147 | -} 148 | fromList : List ( comparable, List ( comparable, o ) ) -> Store comparable comparable o 149 | fromList = 150 | List.map (mapSecond Dict.fromList) 151 | >> Dict.fromList 152 | >> Store 153 | 154 | 155 | {-| 156 | -} 157 | union : Store comparable comparable o -> Store comparable comparable o -> Store comparable comparable o 158 | union st1 st2 = 159 | foldl insertObject st2 st1 160 | 161 | 162 | {-| 163 | -} 164 | fromDicts : Dict comparable (Dict comparable o) -> Store comparable comparable o 165 | fromDicts = 166 | Store 167 | 168 | 169 | {-| 170 | -} 171 | filter : (comparable -> Dict comparable o -> Bool) -> Store comparable comparable o -> Store comparable comparable o 172 | filter func (Store st) = 173 | Dict.filter func st 174 | |> Store 175 | 176 | 177 | {-| 178 | -} 179 | update : comparable -> comparable -> (Maybe o -> Maybe o) -> Store comparable comparable o -> Store comparable comparable o 180 | update s p upd st = 181 | getObject s p st 182 | |> upd 183 | |> Maybe.map (\o -> insertObject s p o st) 184 | |> Maybe.withDefault st 185 | 186 | 187 | {-| 188 | -} 189 | values : Store comparable comparable o -> List o 190 | values (Store st) = 191 | Dict.values st 192 | |> List.map Dict.values 193 | |> List.concat 194 | -------------------------------------------------------------------------------- /tests/.gitignore: -------------------------------------------------------------------------------- 1 | /elm-stuff/ 2 | -------------------------------------------------------------------------------- /tests/Main.elm: -------------------------------------------------------------------------------- 1 | port module Main exposing (..) 2 | 3 | import Tests 4 | import Test.Runner.Node exposing (run, TestProgram) 5 | import Json.Encode exposing (Value) 6 | 7 | 8 | main : TestProgram 9 | main = 10 | run emit Tests.all 11 | 12 | 13 | port emit : ( String, Value ) -> Cmd msg 14 | -------------------------------------------------------------------------------- /tests/Test/Bright.elm: -------------------------------------------------------------------------------- 1 | module Test.Bright exposing (..) 2 | 3 | import Tuple exposing (first, second) 4 | import Test exposing (..) 5 | import Expect 6 | import Bright exposing (charOperation) 7 | import Bright.Model exposing (..) 8 | import String 9 | 10 | 11 | type alias Data = 12 | { current : String 13 | , new : String 14 | , result : List ( Op, Int ) 15 | } 16 | 17 | 18 | data = 19 | [ Data "word" "word" [] 20 | , Data "word" "2word" [ ( Insert (Char '2'), 0 ) ] 21 | , Data "word" "w2ord" [ ( Insert (Char '2'), 1 ) ] 22 | , Data "word" "wo2rd" [ ( Insert (Char '2'), 2 ) ] 23 | , Data "word" "wor2d" [ ( Insert (Char '2'), 3 ) ] 24 | , Data "word" "word2" [ ( Insert (Char '2'), 4 ) ] 25 | , Data "word" "word 2" [ ( Insert (Char ' '), 4 ) ] 26 | , Data "word" "wword" [ ( Insert (Char 'w'), 1 ) ] 27 | , Data "2word" "word" [ ( Remove, 0 ) ] 28 | , Data "w2ord" "word" [ ( Remove, 1 ) ] 29 | , Data "wo2rd" "word" [ ( Remove, 2 ) ] 30 | , Data "wor2d" "word" [ ( Remove, 3 ) ] 31 | , Data "word2" "word" [ ( Remove, 4 ) ] 32 | , Data "word 2" "word" [ ( Remove, 4 ) ] 33 | ] 34 | 35 | 36 | testCharOperation = 37 | describe "CharOperation" <| 38 | List.map 39 | (\{ current, new, result } -> 40 | test ("charOperation from " ++ current ++ " to " ++ new) <| 41 | \() -> 42 | Expect.equal 43 | (charOperation (String.toList current) (String.toList new)) 44 | result 45 | ) 46 | data 47 | 48 | 49 | all : Test 50 | all = 51 | describe "Bright API" <| 52 | [ testCharOperation 53 | ] 54 | -------------------------------------------------------------------------------- /tests/Test/RemoteUpdate.elm: -------------------------------------------------------------------------------- 1 | module Test.RemoteUpdate exposing (..) 2 | 3 | import Tuple exposing (first, second) 4 | import Test exposing (..) 5 | import Expect 6 | import Dict 7 | import PlainArray as Array 8 | import Bright.Update exposing (remoteOperationsUpdate, operations2Body) 9 | import Bright.Model exposing (..) 10 | import String 11 | 12 | 13 | predicate = 14 | "predicate" 15 | 16 | 17 | localOperations = 18 | Array.fromList 19 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 20 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 21 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 22 | ] 23 | 24 | 25 | localOperations2 = 26 | Array.fromList 27 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 28 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 29 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 30 | , Just <| Operation "ns1" predicate 3 <| Insert <| Char 'd' 31 | ] 32 | 33 | 34 | op1 = 35 | ( 3, Operation "ns1" predicate 3 <| Insert <| Char 'd' ) 36 | 37 | 38 | operations1 = 39 | Array.fromList 40 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 41 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 42 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 43 | , Just <| second op1 44 | ] 45 | 46 | 47 | op2 = 48 | ( 3, Operation "ns1" predicate 0 <| Remove ) 49 | 50 | 51 | operations2 = 52 | Array.fromList 53 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 54 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 55 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 56 | , Just <| second op2 57 | ] 58 | 59 | 60 | op3_in = 61 | Operation "ns2" predicate 0 <| Insert <| Char 'x' 62 | 63 | 64 | op3_out = 65 | Operation "ns2" predicate 0 <| Insert <| Char 'x' 66 | 67 | 68 | op31 = 69 | ( 0, op3_in ) 70 | 71 | 72 | operations31 = 73 | Array.fromList 74 | [ Just <| op3_out 75 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'a' 76 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'b' 77 | , Just <| Operation "ns1" predicate 3 <| Insert <| Char 'c' 78 | ] 79 | 80 | 81 | op32 = 82 | ( 1, op3_in ) 83 | 84 | 85 | operations32 = 86 | Array.fromList 87 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 88 | , Just <| op3_out 89 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'b' 90 | , Just <| Operation "ns1" predicate 3 <| Insert <| Char 'c' 91 | ] 92 | 93 | 94 | op33 = 95 | ( 2, op3_in ) 96 | 97 | 98 | operations33 = 99 | Array.fromList 100 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 101 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 102 | , Just <| op3_out 103 | , Just <| Operation "ns1" predicate 3 <| Insert <| Char 'c' 104 | ] 105 | 106 | 107 | op34_1 = 108 | ( 2, Operation "ns2" predicate 1 <| Insert <| Char 'x' ) 109 | 110 | 111 | op34_2 = 112 | ( 3, Operation "ns2" predicate 2 <| Insert <| Char 'y' ) 113 | 114 | 115 | operations34 = 116 | Array.fromList 117 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 118 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 119 | , Just <| Operation "ns2" predicate 1 <| Insert <| Char 'x' 120 | , Just <| Operation "ns2" predicate 2 <| Insert <| Char 'y' 121 | , Just <| Operation "ns1" predicate 4 <| Insert <| Char 'c' 122 | , Just <| Operation "ns1" predicate 5 <| Insert <| Char 'd' 123 | ] 124 | 125 | 126 | localOperations341 = 127 | Array.fromList 128 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 129 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 130 | , Just <| Operation "ns2" predicate 2 <| Insert <| Char 'c' 131 | , Just <| Operation "ns2" predicate 3 <| Insert <| Char 'd' 132 | ] 133 | 134 | 135 | op341_1 = 136 | ( 2, Operation "ns1" predicate 1 <| Insert <| Char 'x' ) 137 | 138 | 139 | op341_2 = 140 | ( 3, Operation "ns1" predicate 2 <| Insert <| Char 'y' ) 141 | 142 | 143 | {-| 144 | folded to axybcd 145 | -} 146 | operations341 = 147 | Array.fromList 148 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 149 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 150 | , Just <| Operation "ns2" predicate 2 <| Insert <| Char 'c' 151 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'x' 152 | , Just <| Operation "ns2" predicate 4 <| Insert <| Char 'd' 153 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'y' 154 | ] 155 | 156 | 157 | 158 | {- 159 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 160 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 161 | , Just <| Operation "ns2" predicate 2 <| Insert <| Char 'c' 162 | , Just <| Operation "ns2" predicate 3 <| Insert <| Char 'd' 163 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'x' 164 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'y' 165 | ] 166 | -} 167 | 168 | 169 | localOperations35 = 170 | Array.fromList 171 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 172 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 173 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'x' 174 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'y' 175 | ] 176 | 177 | 178 | {-| test 341 and 35 should result in the same history 179 | it's the case of two peers syncing their states vice-versa 180 | -} 181 | op35_1 = 182 | ( 2, Operation "ns2" predicate 2 <| Insert <| Char 'c' ) 183 | 184 | 185 | op35_2 = 186 | ( 3, Operation "ns2" predicate 3 <| Insert <| Char 'd' ) 187 | 188 | 189 | {-| 190 | folded to axybcd, but with the wrong history! 191 | TODO: how to adapt the sync algo that the same history as 341 results? 192 | -} 193 | operations35 = 194 | Array.fromList 195 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 196 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 197 | , Just <| Operation "ns2" predicate 2 <| Insert <| Char 'c' 198 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'x' 199 | , Just <| Operation "ns2" predicate 3 <| Insert <| Char 'd' 200 | , Just <| Operation "ns1" predicate 4 <| Insert <| Char 'y' 201 | ] 202 | 203 | 204 | 205 | {- 206 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 207 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 208 | , Just <| Operation "ns2" predicate 2 <| Insert <| Char 'c' 209 | , Just <| Operation "ns2" predicate 3 <| Insert <| Char 'd' 210 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'x' 211 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'y' 212 | ] 213 | -} 214 | 215 | 216 | op4 = 217 | ( 1, Operation "ns2" predicate 0 <| Remove ) 218 | 219 | 220 | operations4 = 221 | Array.fromList 222 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 223 | , Just <| Operation "ns2" predicate 0 <| Remove 224 | , Just <| Operation "ns1" predicate 0 <| Insert <| Char 'b' 225 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'c' 226 | ] 227 | 228 | 229 | op5 = 230 | ( 5, Operation "ns2" predicate 0 <| Remove ) 231 | 232 | 233 | operations5 = 234 | Array.fromList 235 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 236 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 237 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 238 | , Nothing 239 | , Nothing 240 | , Just <| second op5 241 | ] 242 | 243 | 244 | op51 = 245 | ( 4, Operation "ns2" predicate 0 <| Remove ) 246 | 247 | 248 | operations51 = 249 | Array.fromList 250 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 251 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 252 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 253 | , Nothing 254 | , Just <| second op51 255 | , Just <| second op5 256 | ] 257 | 258 | 259 | operations52 = 260 | Array.fromList 261 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 262 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 263 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 264 | , Just <| second op51 265 | , Just <| second op51 266 | , Just <| second op5 267 | ] 268 | 269 | 270 | op3r_in = 271 | Operation "ns0" predicate 0 <| Insert <| Char 'x' 272 | 273 | 274 | op3r_out = 275 | Operation "ns0" predicate 1 <| Insert <| Char 'x' 276 | 277 | 278 | op31r = 279 | ( 0, op3r_in ) 280 | 281 | 282 | operations31r = 283 | Array.fromList 284 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 285 | , Just <| Operation "ns0" predicate 0 <| Insert <| Char 'x' 286 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'b' 287 | , Just <| Operation "ns1" predicate 3 <| Insert <| Char 'c' 288 | ] 289 | 290 | 291 | op32r = 292 | ( 1, op3r_in ) 293 | 294 | 295 | operations32r = 296 | Array.fromList 297 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 298 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 299 | , Just <| Operation "ns0" predicate 0 <| Insert <| Char 'x' 300 | , Just <| Operation "ns1" predicate 3 <| Insert <| Char 'c' 301 | ] 302 | 303 | 304 | op33r = 305 | ( 2, op3r_in ) 306 | 307 | 308 | operations33r = 309 | Array.fromList 310 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 311 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 312 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 313 | , Just <| Operation "ns0" predicate 0 <| Insert <| Char 'x' 314 | ] 315 | 316 | 317 | op34r_1 = 318 | ( 2, Operation "ns0" predicate 1 <| Insert <| Char 'x' ) 319 | 320 | 321 | op34r_2 = 322 | ( 3, Operation "ns0" predicate 2 <| Insert <| Char 'y' ) 323 | 324 | 325 | operations34r = 326 | Array.fromList 327 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 328 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 329 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 330 | , Just <| Operation "ns0" predicate 1 <| Insert <| Char 'x' 331 | , Just <| Operation "ns0" predicate 2 <| Insert <| Char 'y' 332 | , Just <| Operation "ns1" predicate 5 <| Insert <| Char 'd' 333 | ] 334 | 335 | 336 | op4r = 337 | ( 1, Operation "ns0" predicate 0 <| Remove ) 338 | 339 | 340 | operations4r = 341 | Array.fromList 342 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 343 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 344 | , Just <| Operation "ns0" predicate 0 <| Remove 345 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'c' 346 | ] 347 | 348 | 349 | op5r = 350 | ( 5, Operation "ns0" predicate 0 <| Remove ) 351 | 352 | 353 | operations5r = 354 | Array.fromList 355 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 356 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 357 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 358 | , Nothing 359 | , Nothing 360 | , Just <| second op5r 361 | ] 362 | 363 | 364 | op51r = 365 | ( 4, Operation "ns0" predicate 0 <| Remove ) 366 | 367 | 368 | operations51r = 369 | Array.fromList 370 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 371 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 372 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 373 | , Nothing 374 | , Just <| second op51r 375 | , Just <| second op5r 376 | ] 377 | 378 | 379 | operations52r = 380 | Array.fromList 381 | [ Just <| Operation "ns1" predicate 0 <| Insert <| Char 'a' 382 | , Just <| Operation "ns1" predicate 1 <| Insert <| Char 'b' 383 | , Just <| Operation "ns1" predicate 2 <| Insert <| Char 'c' 384 | , Just <| second op51r 385 | , Just <| second op51r 386 | , Just <| second op5r 387 | ] 388 | 389 | 390 | operations6 = 391 | Array.fromList 392 | [ Just <| Operation "ns1" "p1" 0 <| Insert <| Char 'a' 393 | , Just <| Operation "ns1" "p1" 1 <| Insert <| Char 'b' 394 | , Just <| Operation "ns1" "p2" 0 <| Insert <| Char 'c' 395 | , Just <| Operation "ns1" "p2" 1 <| Insert <| Char 'd' 396 | , Just <| Operation "ns1" "p2" 0 <| Remove 397 | ] 398 | 399 | 400 | data = 401 | [ ( "op1", op1, operations1, localOperations, 1 ) 402 | , ( "op2", op2, operations2, localOperations ) 403 | , ( "op31", op31, operations31, localOperations ) 404 | , ( "op32", op32, operations32, localOperations ) 405 | , ( "op33", op33, operations33, localOperations ) 406 | , ( "op4", op4, operations4, localOperations ) 407 | , ( "op5", op5, operations5, localOperations ) 408 | ] 409 | 410 | 411 | data2 = 412 | [ ( "op31r", op31r, operations31r, localOperations ) 413 | , ( "op32r", op32r, operations32r, localOperations ) 414 | , ( "op33r", op33r, operations33r, localOperations ) 415 | , ( "op4r", op4r, operations4r, localOperations ) 416 | , ( "op5r", op5r, operations5r, localOperations ) 417 | , ( "op51r", op51r, operations51r, operations5r ) 418 | ] 419 | 420 | 421 | data3 = 422 | [ ( "op34", [ op34_1, op34_2 ], operations34, localOperations2, 2 ) 423 | , ( "op341", [ op341_1, op341_2 ], operations34, localOperations341, 2 ) 424 | , ( "op35", [ op35_1, op35_2 ], operations35, localOperations35, 2 ) 425 | , ( "op34r", [ op34r_1, op34r_2 ], operations34r, localOperations2, 2 ) 426 | ] 427 | 428 | 429 | words = 430 | [ ( "op1", operations1, [ ( predicate, Literal <| Array.fromList <| String.toList "abcd" ) ] ) 431 | , ( "op2", operations2, [ ( predicate, Literal <| Array.fromList <| String.toList "bc" ) ] ) 432 | , ( "op4", operations4, [ ( predicate, Literal <| Array.fromList <| String.toList "bc" ) ] ) 433 | , ( "op5", operations5, [ ( predicate, Literal <| Array.fromList <| String.toList "bc" ) ] ) 434 | , ( "op51", operations51, [ ( predicate, Literal <| Array.fromList <| String.toList "c" ) ] ) 435 | , ( "op52", operations52, [] ) 436 | , ( "op6" 437 | , operations6 438 | , [ ( "p1", Literal <| Array.fromList [ 'a', 'b' ] ) 439 | , ( "p2", Literal <| Array.fromList [ 'd' ] ) 440 | ] 441 | ) 442 | ] 443 | 444 | 445 | remoteUpdate name data = 446 | describe name <| 447 | List.map 448 | (\( name, op, operations, local, finalStateDelta ) -> 449 | test ("updatePast " ++ name) <| 450 | \() -> 451 | Expect.equal 452 | (remoteOperationsUpdate 0 op local) 453 | ( finalStateDelta, operations ) 454 | ) 455 | data 456 | 457 | 458 | remoteUpdate2 name data = 459 | describe name <| 460 | List.map 461 | (\( name, ops, operations, local, finalStateDelta ) -> 462 | test ("updatePast2 " ++ name) <| 463 | \() -> 464 | Expect.equal 465 | (List.foldl 466 | (\op ( s, local ) -> 467 | remoteOperationsUpdate s op local 468 | ) 469 | ( 0, local ) 470 | ops 471 | ) 472 | ( finalStateDelta, operations ) 473 | ) 474 | data 475 | 476 | 477 | all : Test 478 | all = 479 | describe "Update" <| 480 | [ remoteUpdate "Remote Update" data 481 | , remoteUpdate "Remote Update R" data2 482 | , remoteUpdate2 "Remote Update R2" data3 483 | , describe "Folded" <| 484 | List.map 485 | (\( name, operations, result ) -> 486 | test ("foldOperation " ++ name) <| 487 | \() -> 488 | Expect.equal 489 | (operations2Body operations 490 | |> Dict.toList 491 | ) 492 | result 493 | ) 494 | words 495 | ] 496 | -------------------------------------------------------------------------------- /tests/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Fuzz exposing (list, int, tuple, string) 6 | import String 7 | import Test.RemoteUpdate 8 | import Test.Bright 9 | 10 | 11 | all : Test 12 | all = 13 | describe "All" 14 | [ Test.RemoteUpdate.all 15 | , Test.Bright.all 16 | ] 17 | -------------------------------------------------------------------------------- /tests/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "Sample Elm Test", 4 | "repository": "https://github.com/user/project.git", 5 | "license": "BSD-3-Clause", 6 | "source-directories": [ 7 | ".", 8 | "../src", 9 | "../lib/elm-plain-array/src" 10 | ], 11 | "exposed-modules": [], 12 | "native-modules": true, 13 | "dependencies": { 14 | "elm-community/array-extra": "1.0.2 <= v < 2.0.0", 15 | "elm-community/elm-test": "3.0.0 <= v < 4.0.0", 16 | "elm-community/json-extra": "2.0.0 <= v < 3.0.0", 17 | "elm-community/list-extra": "4.0.0 <= v < 5.0.0", 18 | "elm-community/maybe-extra": "3.0.1 <= v < 4.0.0", 19 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 20 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 21 | "mgold/elm-random-pcg": "4.0.0 <= v < 5.0.0", 22 | "rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0" 23 | }, 24 | "elm-version": "0.18.0 <= v < 0.19.0" 25 | } 26 | --------------------------------------------------------------------------------