├── .github └── workflows │ └── haskell.yml ├── .gitignore ├── README.md ├── cabal.project ├── freezes ├── 20211202-ghc-9.0.1.freeze ├── 20211228-ghc-8.10.7.freeze ├── 20221124-ghc-9.2.5.freeze ├── 20240912-ghc-9.2.1.freeze ├── 20240912-ghc-9.6.1.freeze ├── 20240912-ghc-9.8.1.freeze ├── 20241031-ghc-9.10.1.freeze ├── 20241105-ghc-9.4.1.freeze └── 20241121-ghc-9.10.1.freeze ├── gremlin-test ├── .gitignore ├── build.gradle └── src │ └── test │ └── groovy │ └── com │ └── github │ └── debug_ito │ └── greskell │ ├── MyModern.groovy │ └── TestGremlin.groovy ├── greskell-core ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── greskell-core.cabal ├── src │ └── Data │ │ └── Greskell │ │ ├── AsIterator.hs │ │ ├── GMap.hs │ │ ├── GraphSON.hs │ │ ├── GraphSON │ │ ├── Core.hs │ │ ├── GValue.hs │ │ └── GraphSONTyped.hs │ │ └── Greskell.hs └── test │ ├── Data │ └── Greskell │ │ ├── GMapSpec.hs │ │ ├── GraphSONSpec.hs │ │ ├── GreskellSpec.hs │ │ └── Test │ │ └── QuickCheck.hs │ ├── ExamplesSpec.hs │ └── Spec.hs ├── greskell-websocket ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── greskell-websocket.cabal ├── src │ └── Network │ │ └── Greskell │ │ ├── WebSocket.hs │ │ └── WebSocket │ │ ├── Client.hs │ │ ├── Client │ │ ├── Impl.hs │ │ └── Options.hs │ │ ├── Codec.hs │ │ ├── Codec │ │ └── JSON.hs │ │ ├── Connection.hs │ │ ├── Connection │ │ ├── Impl.hs │ │ ├── Settings.hs │ │ └── Type.hs │ │ ├── Request.hs │ │ ├── Request │ │ ├── Aeson.hs │ │ ├── Common.hs │ │ ├── Session.hs │ │ └── Standard.hs │ │ ├── Response.hs │ │ └── Util.hs └── test │ ├── Network │ └── Greskell │ │ └── WebSocket │ │ ├── Codec │ │ └── JSONSpec.hs │ │ └── ResponseSpec.hs │ ├── ServerTest.hs │ ├── ServerTest │ ├── Client.hs │ └── Connection.hs │ ├── Spec.hs │ ├── TestUtil │ ├── Env.hs │ ├── MockServer.hs │ └── TCounter.hs │ └── samples │ ├── request_auth_v1.json │ ├── request_session_close_v1.json │ ├── request_session_eval_aliased_v1.json │ ├── request_session_eval_v1.json │ ├── request_sessionless_eval_aliased_v1.json │ ├── request_sessionless_eval_v1.json │ ├── response_auth_v1.json │ ├── response_auth_v2.json │ ├── response_auth_v3.json │ ├── response_standard_v1.json │ ├── response_standard_v2.json │ └── response_standard_v3.json ├── greskell ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── greskell.cabal ├── src │ └── Data │ │ ├── Greskell.hs │ │ └── Greskell │ │ ├── AsLabel.hs │ │ ├── Binder.hs │ │ ├── Extra.hs │ │ ├── GTraversal.hs │ │ ├── GTraversal │ │ └── Gen.hs │ │ ├── Graph.hs │ │ ├── Graph │ │ └── PropertyMap.hs │ │ ├── Gremlin.hs │ │ ├── Logic.hs │ │ ├── NonEmptyLike.hs │ │ └── PMap.hs └── test │ ├── Data │ └── Greskell │ │ ├── BinderSpec.hs │ │ ├── ExtraSpec.hs │ │ ├── GTraversalSpec.hs │ │ ├── Graph │ │ └── PropertyMapSpec.hs │ │ ├── GraphSpec.hs │ │ ├── GremlinSpec.hs │ │ ├── LogicSpec.hs │ │ └── PMapSpec.hs │ ├── ExamplesSpec.hs │ ├── ServerBehaviorTest.hs │ ├── ServerTest.hs │ ├── ServerTest │ └── Common.hs │ ├── Spec.hs │ ├── Typecheck.hs │ └── graphson │ ├── edge_v1.json │ ├── edge_v2.json │ ├── edge_v3.json │ ├── path_v1.json │ ├── path_v2.json │ ├── path_v3.json │ ├── property_v1.json │ ├── property_v2.json │ ├── property_v3.json │ ├── vertex_property_v1.json │ ├── vertex_property_v2.json │ ├── vertex_property_v3.json │ ├── vertex_v1.json │ ├── vertex_v2.json │ └── vertex_v3.json ├── run-janusgraph.sh ├── stack.yaml └── test-readme ├── .gitignore ├── LICENSE ├── README.lhs ├── Setup.hs ├── app └── Main.hs └── test-readme.cabal /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: Haskell CI 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | build: 7 | strategy: 8 | matrix: 9 | # os: [ubuntu-latest, macOS-latest] 10 | os: [ubuntu-latest] 11 | plan: 12 | - ghc: latest 13 | allow-fail: true 14 | - ghc: '9.12.1' 15 | - ghc: '9.10.1' 16 | freeze: '20241121-ghc-9.10.1.freeze' 17 | - ghc: '9.8.1' 18 | freeze: '20240912-ghc-9.8.1.freeze' 19 | - ghc: '9.6.1' 20 | freeze: '20240912-ghc-9.6.1.freeze' 21 | - ghc: '9.4.1' 22 | ## freeze: '20241105-ghc-9.4.1.freeze' 23 | - ghc: '9.2.5' 24 | freeze: '20221124-ghc-9.2.5.freeze' 25 | - ghc: '9.2.1' 26 | freeze: '20240912-ghc-9.2.1.freeze' 27 | - ghc: '9.0.1' 28 | freeze: '20211202-ghc-9.0.1.freeze' 29 | - ghc: '8.10.7' 30 | freeze: '20211228-ghc-8.10.7.freeze' 31 | - ghc: '8.10.1' 32 | - ghc: '8.8.1' 33 | 34 | runs-on: ${{ matrix.os }} 35 | continue-on-error: ${{ matrix.plan.allow-fail == true }} 36 | env: 37 | FREEZE: ${{ matrix.plan.freeze }} 38 | 39 | steps: 40 | - uses: actions/checkout@v4 41 | 42 | - uses: haskell-actions/setup@v2 43 | id: cabal-setup-haskell 44 | with: 45 | ghc-version: ${{ matrix.plan.ghc }} 46 | ## We need to avoid cabal-install-3.14 until the issue is resolved https://github.com/haskell/cabal/issues/10704 47 | cabal-version: '3.12' 48 | 49 | - name: Configure and freeze 50 | run: | 51 | set -ex 52 | rm -f cabal.project.freeze 53 | cabal v2-update 54 | cabal v2-configure --enable-tests --enable-benchmarks --test-show-details=streaming 55 | if [ "x" == "x$FREEZE" ]; then cabal v2-freeze; else cp freezes/$FREEZE cabal.project.freeze; fi 56 | cat cabal.project.freeze 57 | 58 | - uses: actions/cache@v4 59 | with: 60 | path: ${{ steps.cabal-setup-haskell.outputs.cabal-store }} 61 | key: ${{ runner.os }}-cabal-${{ hashFiles('cabal.project.freeze') }} 62 | restore-keys: | 63 | ${{ runner.os }}-cabal- 64 | 65 | - name: Install dependencies 66 | run: cabal v2-build --only-dependencies all 67 | - name: Build 68 | run: cabal v2-build all 69 | ## - name: Haddock 70 | ## run: cabal v2-haddock all 71 | - name: Test 72 | run: cabal v2-test --jobs=1 all 73 | 74 | - name: Prepare artifacts 75 | run: | 76 | mkdir output-artifacts 77 | cp dist-newstyle/cache/plan.json output-artifacts/ 78 | cp cabal.project.freeze output-artifacts/ 79 | - uses: actions/upload-artifact@v4 80 | if: ${{ matrix.os == 'ubuntu-latest' }} 81 | with: 82 | name: plans-${{ matrix.plan.ghc }} 83 | path: output-artifacts 84 | 85 | bounds: 86 | runs-on: ubuntu-latest 87 | needs: build 88 | steps: 89 | - uses: actions/checkout@v4 90 | - name: Fetch cabal-plan-bounds 91 | run: | 92 | curl -L https://github.com/nomeata/cabal-plan-bounds/releases/latest/download/cabal-plan-bounds.linux.gz | gunzip > /usr/local/bin/cabal-plan-bounds 93 | chmod +x /usr/local/bin/cabal-plan-bounds 94 | - name: Make directories for work 95 | run: mkdir -p input-artifacts output-artifacts/plans output-artifacts/freezes output-artifacts/cabals 96 | - uses: actions/download-artifact@v4 97 | with: 98 | path: input-artifacts/ 99 | - name: Aggregate build plans 100 | run: | 101 | for d in input-artifacts/*; do 102 | echo $d 103 | plan_id=${d#input-artifacts/plans-} 104 | echo $plan_id 105 | mv $d/plan.json output-artifacts/plans/${plan_id}.json 106 | mv $d/cabal.project.freeze output-artifacts/freezes/${plan_id}.freeze 107 | done 108 | 109 | - name: Modify cabals 110 | run: | 111 | for p in greskell-core greskell greskell-websocket; do 112 | echo modify $p.cabal 113 | cabal-plan-bounds -c $p/$p.cabal output-artifacts/plans/*.json 114 | git diff $p/$p.cabal 115 | cp $p/$p.cabal output-artifacts/cabals/ 116 | done 117 | 118 | - uses: actions/upload-artifact@v4 119 | with: 120 | name: aggregated-plans 121 | path: output-artifacts 122 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virthualenv 8 | .hsenv 9 | .cabal-sandbox/ 10 | cabal.sandbox.config 11 | .stack-work/ 12 | cabal.project.local 13 | dist-newstyle 14 | .ghc.environment* 15 | stack.yaml.lock 16 | cabal.project.freeze 17 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | write-ghc-environment-files: ghc8.4.4+ 2 | packages: greskell-core, 3 | greskell, 4 | greskell-websocket, 5 | test-readme 6 | 7 | -- allow-newer: all 8 | -------------------------------------------------------------------------------- /freezes/20211228-ghc-8.10.7.freeze: -------------------------------------------------------------------------------- 1 | active-repositories: hackage.haskell.org:merge 2 | constraints: any.Cabal ==3.2.1.0, 3 | any.HUnit ==1.6.2.0, 4 | any.OneTuple ==0.3.1, 5 | any.QuickCheck ==2.14.2, 6 | QuickCheck -old-random +templatehaskell, 7 | any.SHA ==1.6.4.4, 8 | SHA -exe, 9 | any.StateVar ==1.2.2, 10 | any.aeson ==2.0.2.0, 11 | aeson -bytestring-builder -cffi +ordered-keymap, 12 | any.ansi-terminal ==0.11.1, 13 | ansi-terminal -example, 14 | any.array ==0.5.4.0, 15 | any.assoc ==1.0.2, 16 | any.async ==2.2.4, 17 | async -bench, 18 | any.attoparsec ==0.14.3, 19 | attoparsec -developer, 20 | any.base ==4.14.3.0, 21 | any.base-compat ==0.12.1, 22 | any.base-compat-batteries ==0.12.1, 23 | any.base-orphans ==0.8.6, 24 | any.base64-bytestring ==1.2.1.0, 25 | any.bifunctors ==5.5.11, 26 | bifunctors +semigroups +tagged, 27 | any.binary ==0.8.8.0, 28 | any.bytestring ==0.10.12.0, 29 | any.bytestring-builder ==0.10.8.2.0, 30 | bytestring-builder +bytestring_has_builder, 31 | any.call-stack ==0.4.0, 32 | any.case-insensitive ==1.2.1.0, 33 | any.clock ==0.8.2, 34 | clock -llvm, 35 | any.code-page ==0.2.1, 36 | any.colour ==2.3.6, 37 | any.comonad ==5.0.8, 38 | comonad +containers +distributive +indexed-traversable, 39 | any.containers ==0.6.5.1, 40 | any.contravariant ==1.5.5, 41 | contravariant +semigroups +statevar +tagged, 42 | any.cryptohash-md5 ==0.11.101.0, 43 | any.cryptohash-sha1 ==0.11.101.0, 44 | any.data-fix ==0.3.2, 45 | any.deepseq ==1.4.4.0, 46 | any.directory ==1.3.6.0, 47 | any.distributive ==0.6.2.1, 48 | distributive +semigroups +tagged, 49 | any.dlist ==1.0, 50 | dlist -werror, 51 | any.doctest ==0.20.0, 52 | any.doctest-discover ==0.2.0.0, 53 | any.entropy ==0.4.1.7, 54 | entropy -halvm, 55 | any.exceptions ==0.10.4, 56 | any.filepath ==1.4.2.1, 57 | any.ghc ==8.10.7, 58 | any.ghc-boot ==8.10.7, 59 | any.ghc-boot-th ==8.10.7, 60 | any.ghc-heap ==8.10.7, 61 | any.ghc-paths ==0.1.0.12, 62 | any.ghc-prim ==0.6.1, 63 | any.ghci ==8.10.7, 64 | any.hashable ==1.4.0.1, 65 | hashable +containers +integer-gmp -random-initial-seed, 66 | any.hashtables ==1.3, 67 | hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks, 68 | any.hpc ==0.6.1.0, 69 | any.hsc2hs ==0.68.8, 70 | hsc2hs -in-ghc-tree, 71 | any.hspec ==2.9.4, 72 | any.hspec-core ==2.9.4, 73 | any.hspec-discover ==2.9.4, 74 | any.hspec-expectations ==0.8.2, 75 | any.hspec-need-env ==0.1.0.8, 76 | any.indexed-traversable ==0.1.2, 77 | any.indexed-traversable-instances ==0.1.1, 78 | any.integer-gmp ==1.0.3.0, 79 | any.integer-logarithms ==1.0.3.1, 80 | integer-logarithms -check-bounds +integer-gmp, 81 | any.markdown-unlit ==0.5.1, 82 | any.mtl ==2.2.2, 83 | any.network ==3.1.2.5, 84 | network -devel, 85 | any.network-info ==0.2.0.10, 86 | any.parsec ==3.1.14.0, 87 | any.pretty ==1.1.3.6, 88 | any.primitive ==0.7.3.0, 89 | any.process ==1.6.13.2, 90 | any.quickcheck-io ==0.2.0, 91 | any.random ==1.2.1, 92 | any.rts ==1.0.1, 93 | any.safe-exceptions ==0.1.7.2, 94 | any.scientific ==0.3.7.0, 95 | scientific -bytestring-builder -integer-simple, 96 | any.semialign ==1.2.0.1, 97 | semialign +semigroupoids, 98 | any.semigroupoids ==5.3.6, 99 | semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, 100 | any.semigroups ==0.20, 101 | semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, 102 | any.setenv ==0.1.1.3, 103 | any.should-not-typecheck ==2.1.0, 104 | any.splitmix ==0.1.0.4, 105 | splitmix -optimised-mixer, 106 | any.stm ==2.5.0.1, 107 | any.streaming-commons ==0.2.2.3, 108 | streaming-commons -use-bytestring-builder, 109 | any.strict ==0.4.0.1, 110 | strict +assoc, 111 | any.syb ==0.7.2.1, 112 | any.tagged ==0.8.6.1, 113 | tagged +deepseq +transformers, 114 | any.template-haskell ==2.16.0.0, 115 | any.terminfo ==0.4.1.4, 116 | any.text ==1.2.4.1, 117 | any.text-short ==0.1.4, 118 | text-short -asserts, 119 | any.tf-random ==0.5, 120 | any.th-abstraction ==0.4.3.0, 121 | any.these ==1.1.1.1, 122 | these +assoc, 123 | any.time ==1.9.3, 124 | any.time-compat ==1.9.6.1, 125 | time-compat -old-locale, 126 | any.transformers ==0.5.6.2, 127 | any.transformers-compat ==0.7.1, 128 | transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, 129 | any.unix ==2.7.2.2, 130 | any.unordered-containers ==0.2.16.0, 131 | unordered-containers -debug, 132 | any.uuid ==1.3.15, 133 | any.uuid-types ==1.0.5, 134 | any.vector ==0.12.3.1, 135 | vector +boundschecks -internalchecks -unsafechecks -wall, 136 | any.websockets ==0.12.7.3, 137 | websockets -example, 138 | any.witherable ==0.4.2, 139 | any.zlib ==0.6.2.3, 140 | zlib -bundled-c-zlib -non-blocking-ffi -pkg-config 141 | index-state: hackage.haskell.org 2021-12-28T01:01:03Z 142 | -------------------------------------------------------------------------------- /freezes/20221124-ghc-9.2.5.freeze: -------------------------------------------------------------------------------- 1 | active-repositories: hackage.haskell.org:merge 2 | constraints: any.Cabal ==3.6.3.0, 3 | any.HUnit ==1.6.2.0, 4 | any.OneTuple ==0.3.1, 5 | any.QuickCheck ==2.14.2, 6 | QuickCheck -old-random +templatehaskell, 7 | any.SHA ==1.6.4.4, 8 | SHA -exe, 9 | any.StateVar ==1.2.2, 10 | any.aeson ==2.1.0.0, 11 | aeson -cffi +ordered-keymap, 12 | any.ansi-terminal ==0.11.3, 13 | ansi-terminal -example, 14 | any.array ==0.5.4.0, 15 | any.assoc ==1.0.2, 16 | any.async ==2.2.4, 17 | async -bench, 18 | any.attoparsec ==0.14.4, 19 | attoparsec -developer, 20 | any.base ==4.16.4.0, 21 | any.base-compat ==0.12.2, 22 | any.base-compat-batteries ==0.12.2, 23 | any.base-orphans ==0.8.7, 24 | any.base64-bytestring ==1.2.1.0, 25 | any.bifunctors ==5.5.13, 26 | bifunctors +semigroups +tagged, 27 | any.binary ==0.8.9.0, 28 | any.bytestring ==0.11.3.1, 29 | any.bytestring-builder ==0.10.8.2.0, 30 | bytestring-builder +bytestring_has_builder, 31 | any.call-stack ==0.4.0, 32 | any.case-insensitive ==1.2.1.0, 33 | any.clock ==0.8.3, 34 | clock -llvm, 35 | any.code-page ==0.2.1, 36 | any.colour ==2.3.6, 37 | any.comonad ==5.0.8, 38 | comonad +containers +distributive +indexed-traversable, 39 | any.containers ==0.6.5.1, 40 | any.contravariant ==1.5.5, 41 | contravariant +semigroups +statevar +tagged, 42 | any.cryptohash-md5 ==0.11.101.0, 43 | any.cryptohash-sha1 ==0.11.101.0, 44 | any.data-fix ==0.3.2, 45 | any.deepseq ==1.4.6.1, 46 | any.directory ==1.3.6.2, 47 | any.distributive ==0.6.2.1, 48 | distributive +semigroups +tagged, 49 | any.dlist ==1.0, 50 | dlist -werror, 51 | any.doctest ==0.20.1, 52 | any.doctest-discover ==0.2.0.0, 53 | any.entropy ==0.4.1.10, 54 | entropy -donotgetentropy, 55 | any.exceptions ==0.10.4, 56 | any.filepath ==1.4.2.2, 57 | any.ghc ==9.2.5, 58 | any.ghc-bignum ==1.2, 59 | any.ghc-boot ==9.2.5, 60 | any.ghc-boot-th ==9.2.5, 61 | any.ghc-heap ==9.2.5, 62 | any.ghc-paths ==0.1.0.12, 63 | any.ghc-prim ==0.8.0, 64 | any.ghci ==9.2.5, 65 | any.hashable ==1.4.1.0, 66 | hashable +containers +integer-gmp -random-initial-seed, 67 | any.hashtables ==1.3.1, 68 | hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks, 69 | any.hpc ==0.6.1.0, 70 | any.hsc2hs ==0.68.8, 71 | hsc2hs -in-ghc-tree, 72 | any.hspec ==2.10.6, 73 | any.hspec-core ==2.10.6, 74 | any.hspec-discover ==2.10.6, 75 | any.hspec-expectations ==0.8.2, 76 | any.hspec-need-env ==0.1.0.10, 77 | any.indexed-traversable ==0.1.2, 78 | any.indexed-traversable-instances ==0.1.1.1, 79 | any.integer-logarithms ==1.0.3.1, 80 | integer-logarithms -check-bounds +integer-gmp, 81 | any.markdown-unlit ==0.5.1, 82 | any.mtl ==2.2.2, 83 | any.network ==3.1.2.7, 84 | network -devel, 85 | any.network-info ==0.2.1, 86 | any.parsec ==3.1.15.0, 87 | any.pretty ==1.1.3.6, 88 | any.primitive ==0.7.4.0, 89 | any.process ==1.6.16.0, 90 | any.quickcheck-io ==0.2.0, 91 | any.random ==1.2.1.1, 92 | any.rts ==1.0.2, 93 | any.safe-exceptions ==0.1.7.3, 94 | any.scientific ==0.3.7.0, 95 | scientific -bytestring-builder -integer-simple, 96 | any.semialign ==1.2.0.1, 97 | semialign +semigroupoids, 98 | any.semigroupoids ==5.3.7, 99 | semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, 100 | any.semigroups ==0.20, 101 | semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, 102 | any.setenv ==0.1.1.3, 103 | any.should-not-typecheck ==2.1.0, 104 | any.splitmix ==0.1.0.4, 105 | splitmix -optimised-mixer, 106 | any.stm ==2.5.0.2, 107 | any.streaming-commons ==0.2.2.5, 108 | streaming-commons -use-bytestring-builder, 109 | any.strict ==0.4.0.1, 110 | strict +assoc, 111 | any.syb ==0.7.2.2, 112 | any.tagged ==0.8.6.1, 113 | tagged +deepseq +transformers, 114 | any.template-haskell ==2.18.0.0, 115 | any.terminfo ==0.4.1.5, 116 | any.text ==1.2.5.0, 117 | any.text-short ==0.1.5, 118 | text-short -asserts, 119 | any.tf-random ==0.5, 120 | any.th-abstraction ==0.4.5.0, 121 | any.these ==1.1.1.1, 122 | these +assoc, 123 | any.time ==1.11.1.1, 124 | any.time-compat ==1.9.6.1, 125 | time-compat -old-locale, 126 | any.transformers ==0.5.6.2, 127 | any.transformers-compat ==0.7.2, 128 | transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, 129 | any.unix ==2.7.2.2, 130 | any.unordered-containers ==0.2.19.1, 131 | unordered-containers -debug, 132 | any.uuid ==1.3.15, 133 | any.uuid-types ==1.0.5, 134 | any.vector ==0.13.0.0, 135 | vector +boundschecks -internalchecks -unsafechecks -wall, 136 | any.vector-stream ==0.1.0.0, 137 | any.websockets ==0.12.7.3, 138 | websockets -example, 139 | any.witherable ==0.4.2, 140 | any.zlib ==0.6.3.0, 141 | zlib -bundled-c-zlib -non-blocking-ffi -pkg-config 142 | index-state: hackage.haskell.org 2022-11-09T02:48:15Z 143 | -------------------------------------------------------------------------------- /freezes/20240912-ghc-9.2.1.freeze: -------------------------------------------------------------------------------- 1 | active-repositories: hackage.haskell.org:merge 2 | constraints: any.Cabal ==3.12.1.0, 3 | any.Cabal-syntax ==3.12.1.0, 4 | any.HUnit ==1.6.2.0, 5 | any.OneTuple ==0.4.2, 6 | any.QuickCheck ==2.15.0.1, 7 | QuickCheck -old-random +templatehaskell, 8 | any.SHA ==1.6.4.4, 9 | SHA -exe, 10 | any.StateVar ==1.2.2, 11 | any.aeson ==2.2.3.0, 12 | aeson +ordered-keymap, 13 | any.alex ==3.5.1.0, 14 | any.ansi-terminal ==1.1.1, 15 | ansi-terminal -example, 16 | any.ansi-terminal-types ==1.1, 17 | any.array ==0.5.4.0, 18 | any.assoc ==1.1.1, 19 | assoc -tagged, 20 | any.async ==2.2.5, 21 | async -bench, 22 | any.attoparsec ==0.14.4, 23 | attoparsec -developer, 24 | any.base ==4.16.0.0, 25 | any.base-compat ==0.14.0, 26 | any.base-orphans ==0.9.2, 27 | any.base64-bytestring ==1.2.1.0, 28 | any.bifunctors ==5.6.2, 29 | bifunctors +tagged, 30 | any.binary ==0.8.9.2, 31 | any.bytestring ==0.12.1.0, 32 | bytestring -pure-haskell, 33 | any.call-stack ==0.4.0, 34 | any.case-insensitive ==1.2.1.0, 35 | any.character-ps ==0.1, 36 | any.colour ==2.3.6, 37 | any.comonad ==5.0.8, 38 | comonad +containers +distributive +indexed-traversable, 39 | any.containers ==0.6.5.1, 40 | any.contravariant ==1.5.5, 41 | contravariant +semigroups +statevar +tagged, 42 | any.cryptohash-md5 ==0.11.101.0, 43 | any.cryptohash-sha1 ==0.11.101.0, 44 | any.data-array-byte ==0.1.0.1, 45 | any.data-fix ==0.3.4, 46 | any.deepseq ==1.4.6.0, 47 | any.directory ==1.3.7.1, 48 | any.distributive ==0.6.2.1, 49 | distributive +semigroups +tagged, 50 | any.dlist ==1.0, 51 | dlist -werror, 52 | any.entropy ==0.4.1.10, 53 | entropy -donotgetentropy, 54 | any.exceptions ==0.10.4, 55 | any.filepath ==1.4.2.1, 56 | any.foldable1-classes-compat ==0.1, 57 | foldable1-classes-compat +tagged, 58 | any.generically ==0.1.1, 59 | any.ghc-bignum ==1.2, 60 | any.ghc-boot-th ==9.2.1, 61 | any.ghc-prim ==0.8.0, 62 | greskell -server-behavior-test -server-test, 63 | greskell-websocket -server-test, 64 | any.hashable ==1.4.7.0, 65 | hashable -arch-native +integer-gmp -random-initial-seed, 66 | any.hashtables ==1.3.1, 67 | hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks, 68 | any.haskell-lexer ==1.1.1, 69 | any.hsc2hs ==0.68.10, 70 | hsc2hs -in-ghc-tree, 71 | any.hspec ==2.11.9, 72 | any.hspec-core ==2.11.9, 73 | any.hspec-discover ==2.11.9, 74 | any.hspec-expectations ==0.8.4, 75 | any.hspec-need-env ==0.1.0.11, 76 | any.indexed-traversable ==0.1.4, 77 | any.indexed-traversable-instances ==0.1.2, 78 | any.integer-conversion ==0.1.1, 79 | any.integer-logarithms ==1.0.3.1, 80 | integer-logarithms -check-bounds +integer-gmp, 81 | any.markdown-unlit ==0.6.0, 82 | any.mtl ==2.2.2, 83 | any.network ==3.2.3.0, 84 | network -devel, 85 | any.network-info ==0.2.1, 86 | any.network-uri ==2.6.4.2, 87 | any.os-string ==2.0.6, 88 | any.parsec ==3.1.17.0, 89 | any.pretty ==1.1.3.6, 90 | any.primitive ==0.9.0.0, 91 | any.process ==1.6.23.0, 92 | any.quickcheck-io ==0.2.0, 93 | any.random ==1.2.1.2, 94 | any.rts ==1.0.2, 95 | any.safe-exceptions ==0.1.7.4, 96 | any.scientific ==0.3.8.0, 97 | scientific -integer-simple, 98 | any.semialign ==1.3.1, 99 | semialign +semigroupoids, 100 | any.semigroupoids ==6.0.1, 101 | semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, 102 | any.semigroups ==0.20, 103 | semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, 104 | any.should-not-typecheck ==2.1.0, 105 | any.splitmix ==0.1.0.5, 106 | splitmix -optimised-mixer, 107 | any.stm ==2.5.0.0, 108 | any.streaming-commons ==0.2.2.6, 109 | streaming-commons -use-bytestring-builder, 110 | any.strict ==0.5.1, 111 | any.tagged ==0.8.8, 112 | tagged +deepseq +transformers, 113 | any.template-haskell ==2.18.0.0, 114 | any.text ==2.1.1, 115 | text -developer -pure-haskell +simdutf, 116 | any.text-iso8601 ==0.1.1, 117 | any.text-short ==0.1.6, 118 | text-short -asserts, 119 | any.tf-random ==0.5, 120 | any.th-abstraction ==0.7.0.0, 121 | any.th-compat ==0.1.5, 122 | any.these ==1.2.1, 123 | any.time ==1.11.1.1, 124 | any.time-compat ==1.9.7, 125 | any.transformers ==0.5.6.2, 126 | any.transformers-compat ==0.7.2, 127 | transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, 128 | any.unix ==2.7.3, 129 | any.unordered-containers ==0.2.20, 130 | unordered-containers -debug, 131 | any.uuid ==1.3.16, 132 | any.uuid-types ==1.0.6, 133 | any.vector ==0.13.1.0, 134 | vector +boundschecks -internalchecks -unsafechecks -wall, 135 | any.vector-stream ==0.1.0.1, 136 | any.websockets ==0.13.0.0, 137 | websockets -example, 138 | any.witherable ==0.5, 139 | any.zlib ==0.7.1.0, 140 | zlib -bundled-c-zlib +non-blocking-ffi +pkg-config 141 | index-state: hackage.haskell.org 2024-09-12T05:43:14Z 142 | -------------------------------------------------------------------------------- /freezes/20240912-ghc-9.6.1.freeze: -------------------------------------------------------------------------------- 1 | active-repositories: hackage.haskell.org:merge 2 | constraints: any.Cabal ==3.12.1.0, 3 | any.Cabal-syntax ==3.12.1.0, 4 | any.HUnit ==1.6.2.0, 5 | any.OneTuple ==0.4.2, 6 | any.QuickCheck ==2.15.0.1, 7 | QuickCheck -old-random +templatehaskell, 8 | any.SHA ==1.6.4.4, 9 | SHA -exe, 10 | any.StateVar ==1.2.2, 11 | any.aeson ==2.2.3.0, 12 | aeson +ordered-keymap, 13 | any.alex ==3.5.1.0, 14 | any.ansi-terminal ==1.1.1, 15 | ansi-terminal -example, 16 | any.ansi-terminal-types ==1.1, 17 | any.array ==0.5.5.0, 18 | any.assoc ==1.1.1, 19 | assoc -tagged, 20 | any.async ==2.2.5, 21 | async -bench, 22 | any.attoparsec ==0.14.4, 23 | attoparsec -developer, 24 | any.base ==4.18.0.0, 25 | any.base-compat ==0.14.0, 26 | any.base-orphans ==0.9.2, 27 | any.base64-bytestring ==1.2.1.0, 28 | any.bifunctors ==5.6.2, 29 | bifunctors +tagged, 30 | any.binary ==0.8.9.1, 31 | any.bytestring ==0.11.4.0, 32 | any.call-stack ==0.4.0, 33 | any.case-insensitive ==1.2.1.0, 34 | any.character-ps ==0.1, 35 | any.colour ==2.3.6, 36 | any.comonad ==5.0.8, 37 | comonad +containers +distributive +indexed-traversable, 38 | any.containers ==0.6.7, 39 | any.contravariant ==1.5.5, 40 | contravariant +semigroups +statevar +tagged, 41 | any.cryptohash-md5 ==0.11.101.0, 42 | any.cryptohash-sha1 ==0.11.101.0, 43 | any.data-fix ==0.3.4, 44 | any.deepseq ==1.4.8.1, 45 | any.directory ==1.3.8.5, 46 | directory +os-string, 47 | any.distributive ==0.6.2.1, 48 | distributive +semigroups +tagged, 49 | any.dlist ==1.0, 50 | dlist -werror, 51 | any.entropy ==0.4.1.10, 52 | entropy -donotgetentropy, 53 | any.exceptions ==0.10.7, 54 | any.filepath ==1.5.3.0, 55 | filepath -cpphs, 56 | any.generically ==0.1.1, 57 | any.ghc-bignum ==1.3, 58 | any.ghc-boot-th ==9.6.1, 59 | any.ghc-prim ==0.10.0, 60 | greskell -server-behavior-test -server-test, 61 | greskell-websocket -server-test, 62 | any.hashable ==1.4.7.0, 63 | hashable -arch-native +integer-gmp -random-initial-seed, 64 | any.hashtables ==1.3.1, 65 | hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks, 66 | any.haskell-lexer ==1.1.1, 67 | any.hsc2hs ==0.68.10, 68 | hsc2hs -in-ghc-tree, 69 | any.hspec ==2.11.9, 70 | any.hspec-core ==2.11.9, 71 | any.hspec-discover ==2.11.9, 72 | any.hspec-expectations ==0.8.4, 73 | any.hspec-need-env ==0.1.0.11, 74 | any.indexed-traversable ==0.1.4, 75 | any.indexed-traversable-instances ==0.1.2, 76 | any.integer-conversion ==0.1.1, 77 | any.integer-logarithms ==1.0.3.1, 78 | integer-logarithms -check-bounds +integer-gmp, 79 | any.markdown-unlit ==0.6.0, 80 | any.mtl ==2.3.1, 81 | any.network ==3.2.3.0, 82 | network -devel, 83 | any.network-info ==0.2.1, 84 | any.network-uri ==2.6.4.2, 85 | any.os-string ==2.0.6, 86 | any.parsec ==3.1.16.1, 87 | any.pretty ==1.1.3.6, 88 | any.primitive ==0.9.0.0, 89 | any.process ==1.6.23.0, 90 | any.quickcheck-io ==0.2.0, 91 | any.random ==1.2.1.2, 92 | any.rts ==1.0.2, 93 | any.safe-exceptions ==0.1.7.4, 94 | any.scientific ==0.3.8.0, 95 | scientific -integer-simple, 96 | any.semialign ==1.3.1, 97 | semialign +semigroupoids, 98 | any.semigroupoids ==6.0.1, 99 | semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, 100 | any.semigroups ==0.20, 101 | semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, 102 | any.should-not-typecheck ==2.1.0, 103 | any.splitmix ==0.1.0.5, 104 | splitmix -optimised-mixer, 105 | any.stm ==2.5.1.0, 106 | any.streaming-commons ==0.2.2.6, 107 | streaming-commons -use-bytestring-builder, 108 | any.strict ==0.5.1, 109 | any.tagged ==0.8.8, 110 | tagged +deepseq +transformers, 111 | any.template-haskell ==2.20.0.0, 112 | any.text ==2.0.2, 113 | any.text-iso8601 ==0.1.1, 114 | any.text-short ==0.1.6, 115 | text-short -asserts, 116 | any.tf-random ==0.5, 117 | any.th-abstraction ==0.7.0.0, 118 | any.th-compat ==0.1.5, 119 | any.these ==1.2.1, 120 | any.time ==1.12.2, 121 | any.time-compat ==1.9.7, 122 | any.transformers ==0.6.1.0, 123 | any.transformers-compat ==0.7.2, 124 | transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, 125 | any.unix ==2.8.5.1, 126 | unix +os-string, 127 | any.unordered-containers ==0.2.20, 128 | unordered-containers -debug, 129 | any.uuid ==1.3.16, 130 | any.uuid-types ==1.0.6, 131 | any.vector ==0.13.1.0, 132 | vector +boundschecks -internalchecks -unsafechecks -wall, 133 | any.vector-stream ==0.1.0.1, 134 | any.websockets ==0.13.0.0, 135 | websockets -example, 136 | any.witherable ==0.5, 137 | any.zlib ==0.7.1.0, 138 | zlib -bundled-c-zlib +non-blocking-ffi +pkg-config 139 | index-state: hackage.haskell.org 2024-09-12T04:55:50Z 140 | -------------------------------------------------------------------------------- /freezes/20240912-ghc-9.8.1.freeze: -------------------------------------------------------------------------------- 1 | active-repositories: hackage.haskell.org:merge 2 | constraints: any.Cabal ==3.12.1.0, 3 | any.Cabal-syntax ==3.12.1.0, 4 | any.HUnit ==1.6.2.0, 5 | any.OneTuple ==0.4.2, 6 | any.QuickCheck ==2.15.0.1, 7 | QuickCheck -old-random +templatehaskell, 8 | any.SHA ==1.6.4.4, 9 | SHA -exe, 10 | any.StateVar ==1.2.2, 11 | any.aeson ==2.2.3.0, 12 | aeson +ordered-keymap, 13 | any.alex ==3.5.1.0, 14 | any.ansi-terminal ==1.1.1, 15 | ansi-terminal -example, 16 | any.ansi-terminal-types ==1.1, 17 | any.array ==0.5.6.0, 18 | any.assoc ==1.1.1, 19 | assoc -tagged, 20 | any.async ==2.2.5, 21 | async -bench, 22 | any.attoparsec ==0.14.4, 23 | attoparsec -developer, 24 | any.base ==4.19.0.0, 25 | any.base-compat ==0.14.0, 26 | any.base-orphans ==0.9.2, 27 | any.base64-bytestring ==1.2.1.0, 28 | any.bifunctors ==5.6.2, 29 | bifunctors +tagged, 30 | any.binary ==0.8.9.1, 31 | any.bytestring ==0.12.0.2, 32 | any.call-stack ==0.4.0, 33 | any.case-insensitive ==1.2.1.0, 34 | any.character-ps ==0.1, 35 | any.colour ==2.3.6, 36 | any.comonad ==5.0.8, 37 | comonad +containers +distributive +indexed-traversable, 38 | any.containers ==0.6.8, 39 | any.contravariant ==1.5.5, 40 | contravariant +semigroups +statevar +tagged, 41 | any.cryptohash-md5 ==0.11.101.0, 42 | any.cryptohash-sha1 ==0.11.101.0, 43 | any.data-fix ==0.3.4, 44 | any.deepseq ==1.5.0.0, 45 | any.directory ==1.3.8.5, 46 | directory +os-string, 47 | any.distributive ==0.6.2.1, 48 | distributive +semigroups +tagged, 49 | any.dlist ==1.0, 50 | dlist -werror, 51 | any.entropy ==0.4.1.10, 52 | entropy -donotgetentropy, 53 | any.exceptions ==0.10.7, 54 | any.filepath ==1.5.3.0, 55 | filepath -cpphs, 56 | any.generically ==0.1.1, 57 | any.ghc-bignum ==1.3, 58 | any.ghc-boot-th ==9.8.1, 59 | any.ghc-prim ==0.11.0, 60 | greskell -server-behavior-test -server-test, 61 | greskell-websocket -server-test, 62 | any.hashable ==1.4.7.0, 63 | hashable -arch-native +integer-gmp -random-initial-seed, 64 | any.hashtables ==1.3.1, 65 | hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks, 66 | any.haskell-lexer ==1.1.1, 67 | any.hsc2hs ==0.68.10, 68 | hsc2hs -in-ghc-tree, 69 | any.hspec ==2.11.9, 70 | any.hspec-core ==2.11.9, 71 | any.hspec-discover ==2.11.9, 72 | any.hspec-expectations ==0.8.4, 73 | any.hspec-need-env ==0.1.0.11, 74 | any.indexed-traversable ==0.1.4, 75 | any.indexed-traversable-instances ==0.1.2, 76 | any.integer-conversion ==0.1.1, 77 | any.integer-logarithms ==1.0.3.1, 78 | integer-logarithms -check-bounds +integer-gmp, 79 | any.markdown-unlit ==0.6.0, 80 | any.mtl ==2.3.1, 81 | any.network ==3.2.3.0, 82 | network -devel, 83 | any.network-info ==0.2.1, 84 | any.network-uri ==2.6.4.2, 85 | any.os-string ==2.0.6, 86 | any.parsec ==3.1.17.0, 87 | any.pretty ==1.1.3.6, 88 | any.primitive ==0.9.0.0, 89 | any.process ==1.6.23.0, 90 | any.quickcheck-io ==0.2.0, 91 | any.random ==1.2.1.2, 92 | any.rts ==1.0.2, 93 | any.safe-exceptions ==0.1.7.4, 94 | any.scientific ==0.3.8.0, 95 | scientific -integer-simple, 96 | any.semialign ==1.3.1, 97 | semialign +semigroupoids, 98 | any.semigroupoids ==6.0.1, 99 | semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, 100 | any.semigroups ==0.20, 101 | semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, 102 | any.should-not-typecheck ==2.1.0, 103 | any.splitmix ==0.1.0.5, 104 | splitmix -optimised-mixer, 105 | any.stm ==2.5.2.1, 106 | any.streaming-commons ==0.2.2.6, 107 | streaming-commons -use-bytestring-builder, 108 | any.strict ==0.5.1, 109 | any.tagged ==0.8.8, 110 | tagged +deepseq +transformers, 111 | any.template-haskell ==2.21.0.0, 112 | any.text ==2.1, 113 | any.text-iso8601 ==0.1.1, 114 | any.text-short ==0.1.6, 115 | text-short -asserts, 116 | any.tf-random ==0.5, 117 | any.th-abstraction ==0.7.0.0, 118 | any.th-compat ==0.1.5, 119 | any.these ==1.2.1, 120 | any.time ==1.12.2, 121 | any.time-compat ==1.9.7, 122 | any.transformers ==0.6.1.0, 123 | any.transformers-compat ==0.7.2, 124 | transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, 125 | any.unix ==2.8.5.1, 126 | unix +os-string, 127 | any.unordered-containers ==0.2.20, 128 | unordered-containers -debug, 129 | any.uuid ==1.3.16, 130 | any.uuid-types ==1.0.6, 131 | any.vector ==0.13.1.0, 132 | vector +boundschecks -internalchecks -unsafechecks -wall, 133 | any.vector-stream ==0.1.0.1, 134 | any.websockets ==0.13.0.0, 135 | websockets -example, 136 | any.witherable ==0.5, 137 | any.zlib ==0.7.1.0, 138 | zlib -bundled-c-zlib +non-blocking-ffi +pkg-config 139 | index-state: hackage.haskell.org 2024-09-12T05:43:14Z 140 | -------------------------------------------------------------------------------- /freezes/20241031-ghc-9.10.1.freeze: -------------------------------------------------------------------------------- 1 | active-repositories: hackage.haskell.org:merge 2 | constraints: any.Cabal ==3.12.0.0, 3 | any.Cabal-syntax ==3.12.0.0, 4 | any.HUnit ==1.6.2.0, 5 | any.OneTuple ==0.4.2, 6 | any.QuickCheck ==2.15.0.1, 7 | QuickCheck -old-random +templatehaskell, 8 | any.SHA ==1.6.4.4, 9 | SHA -exe, 10 | any.StateVar ==1.2.2, 11 | any.aeson ==2.2.3.0, 12 | aeson +ordered-keymap, 13 | any.ansi-terminal ==1.1.1, 14 | ansi-terminal -example, 15 | any.ansi-terminal-types ==1.1, 16 | any.array ==0.5.7.0, 17 | any.assoc ==1.1.1, 18 | assoc -tagged, 19 | any.async ==2.2.5, 20 | async -bench, 21 | any.attoparsec ==0.14.4, 22 | attoparsec -developer, 23 | any.base ==4.20.0.0, 24 | any.base-compat ==0.14.0, 25 | any.base-orphans ==0.9.2, 26 | any.base64-bytestring ==1.2.1.0, 27 | any.bifunctors ==5.6.2, 28 | bifunctors +tagged, 29 | any.binary ==0.8.9.2, 30 | any.bytestring ==0.12.1.0, 31 | any.call-stack ==0.4.0, 32 | any.case-insensitive ==1.2.1.0, 33 | any.character-ps ==0.1, 34 | any.colour ==2.3.6, 35 | any.comonad ==5.0.8, 36 | comonad +containers +distributive +indexed-traversable, 37 | any.containers ==0.7, 38 | any.contravariant ==1.5.5, 39 | contravariant +semigroups +statevar +tagged, 40 | any.cryptohash-md5 ==0.11.101.0, 41 | any.cryptohash-sha1 ==0.11.101.0, 42 | any.data-fix ==0.3.4, 43 | any.deepseq ==1.5.0.0, 44 | any.directory ==1.3.8.3, 45 | any.distributive ==0.6.2.1, 46 | distributive +semigroups +tagged, 47 | any.dlist ==1.0, 48 | dlist -werror, 49 | any.entropy ==0.4.1.10, 50 | entropy -donotgetentropy, 51 | any.exceptions ==0.10.7, 52 | any.filepath ==1.5.2.0, 53 | any.generically ==0.1.1, 54 | any.ghc-bignum ==1.3, 55 | any.ghc-boot-th ==9.10.1, 56 | any.ghc-internal ==9.1001.0, 57 | any.ghc-prim ==0.11.0, 58 | greskell -server-behavior-test -server-test, 59 | greskell-websocket -server-test, 60 | any.hashable ==1.5.0.0, 61 | hashable -arch-native -random-initial-seed, 62 | any.hashtables ==1.3.1, 63 | hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks, 64 | any.haskell-lexer ==1.1.2, 65 | any.hsc2hs ==0.68.10, 66 | hsc2hs -in-ghc-tree, 67 | any.hspec ==2.11.9, 68 | any.hspec-core ==2.11.9, 69 | any.hspec-discover ==2.11.9, 70 | any.hspec-expectations ==0.8.4, 71 | any.hspec-need-env ==0.1.0.11, 72 | any.indexed-traversable ==0.1.4, 73 | any.indexed-traversable-instances ==0.1.2, 74 | any.integer-conversion ==0.1.1, 75 | any.integer-logarithms ==1.0.3.1, 76 | integer-logarithms -check-bounds +integer-gmp, 77 | any.markdown-unlit ==0.6.0, 78 | any.mtl ==2.3.1, 79 | any.network ==3.2.4.0, 80 | network -devel, 81 | any.network-info ==0.2.1, 82 | any.network-uri ==2.6.4.2, 83 | any.os-string ==2.0.2, 84 | any.parsec ==3.1.17.0, 85 | any.pretty ==1.1.3.6, 86 | any.primitive ==0.9.0.0, 87 | any.process ==1.6.19.0, 88 | any.quickcheck-io ==0.2.0, 89 | any.random ==1.2.1.2, 90 | any.rts ==1.0.2, 91 | any.safe-exceptions ==0.1.7.4, 92 | any.scientific ==0.3.8.0, 93 | scientific -integer-simple, 94 | any.semialign ==1.3.1, 95 | semialign +semigroupoids, 96 | any.semigroupoids ==6.0.1, 97 | semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, 98 | any.semigroups ==0.20, 99 | semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, 100 | any.should-not-typecheck ==2.1.0, 101 | any.splitmix ==0.1.0.5, 102 | splitmix -optimised-mixer, 103 | any.stm ==2.5.3.1, 104 | any.streaming-commons ==0.2.2.6, 105 | streaming-commons -use-bytestring-builder, 106 | any.strict ==0.5.1, 107 | any.tagged ==0.8.8, 108 | tagged +deepseq +transformers, 109 | any.template-haskell ==2.22.0.0, 110 | any.text ==2.1.1, 111 | any.text-iso8601 ==0.1.1, 112 | any.text-short ==0.1.6, 113 | text-short -asserts, 114 | any.tf-random ==0.5, 115 | any.th-abstraction ==0.7.0.0, 116 | any.th-compat ==0.1.5, 117 | any.these ==1.2.1, 118 | any.time ==1.12.2, 119 | any.time-compat ==1.9.7, 120 | any.transformers ==0.6.1.1, 121 | any.transformers-compat ==0.7.2, 122 | transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, 123 | any.unix ==2.8.5.1, 124 | any.unordered-containers ==0.2.20, 125 | unordered-containers -debug, 126 | any.uuid ==1.3.16, 127 | any.uuid-types ==1.0.6, 128 | any.vector ==0.13.1.0, 129 | vector +boundschecks -internalchecks -unsafechecks -wall, 130 | any.vector-stream ==0.1.0.1, 131 | any.websockets ==0.13.0.0, 132 | websockets -example, 133 | any.witherable ==0.5, 134 | any.zlib ==0.7.1.0, 135 | zlib -bundled-c-zlib +non-blocking-ffi +pkg-config 136 | index-state: hackage.haskell.org 2024-10-31T05:31:52Z 137 | -------------------------------------------------------------------------------- /freezes/20241105-ghc-9.4.1.freeze: -------------------------------------------------------------------------------- 1 | active-repositories: hackage.haskell.org:merge 2 | constraints: any.Cabal ==3.8.1.0, 3 | any.Cabal-syntax ==3.8.1.0, 4 | any.HUnit ==1.6.2.0, 5 | any.OneTuple ==0.4.2, 6 | any.QuickCheck ==2.15.0.1, 7 | QuickCheck -old-random +templatehaskell, 8 | any.SHA ==1.6.4.4, 9 | SHA -exe, 10 | any.StateVar ==1.2.2, 11 | any.aeson ==2.0.3.0, 12 | aeson -cffi +ordered-keymap, 13 | any.ansi-terminal ==1.1.1, 14 | ansi-terminal -example, 15 | any.ansi-terminal-types ==1.1, 16 | any.array ==0.5.4.0, 17 | any.assoc ==1.1.1, 18 | assoc -tagged, 19 | any.async ==2.2.5, 20 | async -bench, 21 | any.attoparsec ==0.14.4, 22 | attoparsec -developer, 23 | any.base ==4.17.0.0, 24 | any.base-compat ==0.14.0, 25 | any.base-compat-batteries ==0.14.0, 26 | any.base-orphans ==0.9.2, 27 | any.base64-bytestring ==1.2.1.0, 28 | any.bifunctors ==5.6.2, 29 | bifunctors +tagged, 30 | any.binary ==0.8.9.1, 31 | any.bytestring ==0.11.3.1, 32 | any.call-stack ==0.4.0, 33 | any.case-insensitive ==1.2.1.0, 34 | any.colour ==2.3.6, 35 | any.comonad ==5.0.8, 36 | comonad +containers +distributive +indexed-traversable, 37 | any.containers ==0.6.6, 38 | any.contravariant ==1.5.5, 39 | contravariant +semigroups +statevar +tagged, 40 | any.cryptohash-md5 ==0.11.101.0, 41 | any.cryptohash-sha1 ==0.11.101.0, 42 | any.data-fix ==0.3.4, 43 | any.deepseq ==1.4.8.0, 44 | any.directory ==1.3.7.1, 45 | any.distributive ==0.6.2.1, 46 | distributive +semigroups +tagged, 47 | any.dlist ==1.0, 48 | dlist -werror, 49 | any.entropy ==0.4.1.10, 50 | entropy -donotgetentropy, 51 | any.exceptions ==0.10.5, 52 | any.filepath ==1.4.2.2, 53 | any.foldable1-classes-compat ==0.1, 54 | foldable1-classes-compat +tagged, 55 | any.ghc-bignum ==1.3, 56 | any.ghc-boot-th ==9.4.1, 57 | any.ghc-prim ==0.9.0, 58 | greskell -server-behavior-test -server-test, 59 | greskell-websocket -server-test, 60 | any.hashable ==1.4.7.0, 61 | hashable -arch-native +integer-gmp -random-initial-seed, 62 | any.hashtables ==1.3.1, 63 | hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks, 64 | any.haskell-lexer ==1.1.2, 65 | any.hsc2hs ==0.68.10, 66 | hsc2hs -in-ghc-tree, 67 | any.hspec ==2.11.9, 68 | any.hspec-core ==2.11.9, 69 | any.hspec-discover ==2.11.9, 70 | any.hspec-expectations ==0.8.4, 71 | any.hspec-need-env ==0.1.0.11, 72 | any.indexed-traversable ==0.1.4, 73 | any.indexed-traversable-instances ==0.1.2, 74 | any.integer-logarithms ==1.0.3.1, 75 | integer-logarithms -check-bounds +integer-gmp, 76 | any.markdown-unlit ==0.6.0, 77 | any.mtl ==2.2.2, 78 | any.network ==3.2.4.0, 79 | network -devel, 80 | any.network-info ==0.2.1, 81 | any.optparse-applicative ==0.18.1.0, 82 | optparse-applicative +process, 83 | any.os-string ==2.0.6, 84 | any.parsec ==3.1.15.0, 85 | any.pretty ==1.1.3.6, 86 | any.prettyprinter ==1.7.1, 87 | prettyprinter -buildreadme +text, 88 | any.prettyprinter-ansi-terminal ==1.1.3, 89 | any.primitive ==0.9.0.0, 90 | any.process ==1.6.15.0, 91 | any.quickcheck-io ==0.2.0, 92 | any.random ==1.2.1.2, 93 | any.rts ==1.0.2, 94 | any.safe-exceptions ==0.1.7.4, 95 | any.scientific ==0.3.8.0, 96 | scientific -integer-simple, 97 | any.semialign ==1.3.1, 98 | semialign +semigroupoids, 99 | any.semigroupoids ==6.0.1, 100 | semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, 101 | any.semigroups ==0.20, 102 | semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, 103 | any.should-not-typecheck ==2.1.0, 104 | any.splitmix ==0.1.0.5, 105 | splitmix -optimised-mixer, 106 | any.stm ==2.5.1.0, 107 | any.streaming-commons ==0.2.2.6, 108 | streaming-commons -use-bytestring-builder, 109 | any.strict ==0.5.1, 110 | any.tagged ==0.8.8, 111 | tagged +deepseq +transformers, 112 | any.tasty ==1.5.2, 113 | tasty +unix, 114 | any.template-haskell ==2.19.0.0, 115 | any.text ==1.2.5.0 || ==2.0.1, 116 | text -developer, 117 | any.text-short ==0.1.6, 118 | text-short -asserts, 119 | any.tf-random ==0.5, 120 | any.th-abstraction ==0.7.0.0, 121 | any.these ==1.2.1, 122 | any.time ==1.12.2, 123 | any.time-compat ==1.9.7, 124 | any.transformers ==0.5.6.2, 125 | any.transformers-compat ==0.7.2, 126 | transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, 127 | any.unix ==2.7.3, 128 | any.unordered-containers ==0.2.20, 129 | unordered-containers -debug, 130 | any.uuid ==1.3.16, 131 | any.uuid-types ==1.0.6, 132 | any.vector ==0.13.2.0, 133 | vector +boundschecks -internalchecks -unsafechecks -wall, 134 | any.vector-stream ==0.1.0.1, 135 | any.websockets ==0.13.0.0, 136 | websockets -example, 137 | any.witherable ==0.5, 138 | any.zlib ==0.7.1.0, 139 | zlib -bundled-c-zlib +non-blocking-ffi +pkg-config 140 | index-state: hackage.haskell.org 2024-11-05T02:34:35Z 141 | -------------------------------------------------------------------------------- /gremlin-test/.gitignore: -------------------------------------------------------------------------------- 1 | .gradle 2 | build 3 | -------------------------------------------------------------------------------- /gremlin-test/build.gradle: -------------------------------------------------------------------------------- 1 | apply plugin: 'groovy' 2 | 3 | repositories { 4 | mavenCentral() 5 | } 6 | 7 | dependencies { 8 | testCompile 'org.codehaus.groovy:groovy-all:2.4.10' 9 | testCompile 'junit:junit:4.12' 10 | testCompile 'org.apache.tinkerpop:gremlin-core:3.4.6' 11 | testCompile 'org.apache.tinkerpop:tinkergraph-gremlin:3.4.6' 12 | } 13 | -------------------------------------------------------------------------------- /gremlin-test/src/test/groovy/com/github/debug_ito/greskell/MyModern.groovy: -------------------------------------------------------------------------------- 1 | package com.github.debug_ito.greskell; 2 | 3 | import org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph; 4 | import org.apache.tinkerpop.gremlin.structure.Graph; 5 | import org.apache.tinkerpop.gremlin.structure.Vertex; 6 | import org.apache.tinkerpop.gremlin.structure.Edge; 7 | 8 | public class MyModern { 9 | public Graph graph; 10 | 11 | /** 12 | * Create the "modern" toy graph of TinkerPop-3.3.0 13 | * documentation. We don't use TinkerFactory.createModern(), because 14 | * it may be unstable across TinkerPop versions. 15 | */ 16 | static public Graph make() { 17 | MyModern m = new MyModern(); 18 | m.init(); 19 | return m.graph; 20 | } 21 | 22 | private MyModern() { 23 | graph = null; 24 | } 25 | 26 | private void init() { 27 | graph = TinkerGraph.open(); 28 | Vertex marko = makePerson("marko", 29); 29 | Vertex vadas = makePerson("vadas", 27); 30 | Vertex lop = makeSoftware("lop", "java"); 31 | Vertex josh = makePerson("josh", 32); 32 | Vertex ripple = makeSoftware("ripple", "java"); 33 | Vertex peter = makePerson("peter", 35) 34 | 35 | makeEdge(marko, vadas, "knows", 0.5); 36 | makeEdge(marko, josh, "knows", 1.0); 37 | makeEdge(marko, lop, "created", 0.4); 38 | makeEdge(josh, ripple, "created", 1.0); 39 | makeEdge(josh, lop, "created", 0.4); 40 | makeEdge(peter, lop, "created", 0.2); 41 | } 42 | 43 | public Vertex makePerson(String name, int age) { 44 | Vertex v = graph.addVertex("person"); 45 | v.property("name", name); 46 | v.property("age", age); 47 | return v; 48 | } 49 | 50 | public Vertex makeSoftware(String name, String lang) { 51 | Vertex v = graph.addVertex("software"); 52 | v.property("name", name); 53 | v.property("lang", lang); 54 | return v; 55 | } 56 | 57 | public Edge makeEdge(Vertex from, Vertex to, String label, double weight) { 58 | return from.addEdge(label, to, "weight", weight); 59 | } 60 | 61 | } 62 | -------------------------------------------------------------------------------- /greskell-core/.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virthualenv 8 | .hsenv 9 | .cabal-sandbox/ 10 | cabal.sandbox.config 11 | .stack-work/ 12 | -------------------------------------------------------------------------------- /greskell-core/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for greskell-core 2 | 3 | ## 1.0.0.4 -- 2025-01-30 4 | 5 | * Support ghc-9.12 (base-4.21). 6 | 7 | ## 1.0.0.3 -- 2024-11-05 8 | 9 | * Bump dependency version bounds. 10 | 11 | ## 1.0.0.2 -- 2024-09-12 12 | 13 | * Update dependency version bounds with cabal-plan-bounds. 14 | This adds support for new packages, while drops support for old ones. 15 | 16 | ## 1.0.0.1 -- 2022-11-24 17 | 18 | * Confirm test with ghc-9.2.5, vector-0.13.0.0 and aeson-2.1.0.0. 19 | * Remove doctests. This is because it's so difficult to maintain doctests with recent GHCs and cabals. 20 | * doctests have been moved to `examples` function defined in some modules. 21 | * Use stylish-haskell to format codes. 22 | 23 | ## 1.0.0.0 -- 2021-12-28 24 | 25 | * **BREAKING CHANGE**: `GObject` variant of `GValueBody` is now based on `KeyMap` from `aeson-2.0`. 26 | Before, it was based on `HashMap Text`. 27 | As a result, signature of the following functions has been changed. 28 | * `parseToGMap` 29 | * `parseToGMapEntry` 30 | * `(.:)` 31 | * **BREAKING CHANGE**: Remove `FromGraphSON` instance for `Data.Semigroup.Option`, which is deprecated. 32 | * Add `FromGraphSON` instance to `KeyMap` and `Key` from `aeson-2.0`. 33 | * Confirm test with `aeson-2.0.2.0`, `semigroups-0.20` and `hashable-1.4.0.1`, `doctest-0.19.0`, `doctest-0.20.0`. 34 | 35 | 36 | ## 0.1.3.7 -- 2021-11-08 37 | 38 | * Confirm test with `base-4.15.0.0` 39 | 40 | ## 0.1.3.6 -- 2021-02-11 41 | 42 | * Confirm test with `doctest-0.18`. 43 | 44 | ## 0.1.3.5 -- 2020-06-21 45 | 46 | * Confirm test with `base-4.14.0.0` 47 | 48 | ## 0.1.3.4 -- 2020-06-06 49 | 50 | * Support `doctest-0.17`. 51 | 52 | ## 0.1.3.3 -- 2020-05-30 53 | 54 | * Support `aeson-1.5.0.0`. 55 | 56 | ## 0.1.3.2 -- 2020-03-29 57 | 58 | * Confirm test with `QuickCheck-2.14`. 59 | 60 | ## 0.1.3.1 -- 2019-12-30 61 | 62 | * Confirm test with `base-4.13.0.0` 63 | 64 | ## 0.1.3.0 -- 2019-12-27 65 | 66 | ### GraphSON module 67 | 68 | * Add `FromGraphSON` instances to the following wrapper types. 69 | * `Identity` functor 70 | * `NonEmpty` list 71 | * From `Data.Semigroup` 72 | * `Min` 73 | * `Max` 74 | * `First` 75 | * `Last` 76 | * `WrappedMonoid` 77 | * `Dual` 78 | * `Option` 79 | * From `Data.Monoid` 80 | * `First` 81 | * `Last` 82 | * `Sum` 83 | * `Product` 84 | * `All` 85 | * `Any` 86 | 87 | ### AsIterator module 88 | 89 | * Add `AsIterator` instance to `NonEmpty`. 90 | 91 | ## 0.1.2.7 -- 2019-10-02 92 | 93 | * Confirm test with `hashable-1.3.0.0` and `semigroups-0.19.1`. 94 | 95 | ## 0.1.2.6 -- 2019-06-10 96 | 97 | * Adapt test spec to `aeson-1.4.3.0` (#1). 98 | 99 | 100 | ## 0.1.2.5 -- 2019-03-31 101 | 102 | * Confirm test with `QuickCheck-2.13.1`. 103 | 104 | ## 0.1.2.4 -- 2018-10-03 105 | 106 | * Confirm test with `base-4.12.0.0` and `containers-0.6.0.1` 107 | 108 | 109 | ## 0.1.2.3 -- 2018-09-05 110 | 111 | * Confirmed test with `QuickCheck-2.12` and `hspec-2.5.6`. 112 | 113 | 114 | ## 0.1.2.2 -- 2018-07-24 115 | 116 | * Confirmed test with `doctest-discover-0.2.0.0`. 117 | 118 | 119 | ## 0.1.2.1 -- 2018-06-24 120 | 121 | * Confirmed test with `doctest-0.16.0`. 122 | 123 | 124 | ## 0.1.2.0 -- 2018-06-21 125 | 126 | * Add `GMap` module. 127 | * Add `AsIterator` module. 128 | * Add `GraphSON.GValue` module. 129 | * Confirmed test with `aeson-1.4.0.0`. 130 | 131 | ### GraphSON module 132 | 133 | * Change behavior of `instance FromJSON GraphSON`. Now {"@type": null} 134 | goes to failure. Before, "@type":null fell back to direct (bare) 135 | parsing. If it finds "@type" key, I think it should expect that the 136 | JSON object is a GraphSON wrapper. It's more or less a bug fix, so 137 | it doesn't bump major version. 138 | * Add `Generic` and `Hashable` instances to `GraphSON`. 139 | * Add `GValue` and `GValueBody` types and related functions. 140 | * Add `FromGraphSON` class and related functions. 141 | * Add `instance GraphSONTyped Either`. 142 | * Add `instance GraphSONTyped` to types in `containers` package. 143 | * Re-export Aeson's `Parser` type for convenience. 144 | 145 | ### Greskell module 146 | 147 | * Add `valueInt`, `gvalue`, `gvalueInt` functions. 148 | 149 | 150 | ## 0.1.1.0 -- 2018-04-08 151 | 152 | * Add Semigroup instance to Greskell. 153 | * Confirmed test with base-4.11. 154 | 155 | 156 | ## 0.1.0.0 -- 2018-03-12 157 | 158 | * First version. Released on an unsuspecting world. 159 | -------------------------------------------------------------------------------- /greskell-core/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Toshio Ito 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Toshio Ito nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /greskell-core/README.md: -------------------------------------------------------------------------------- 1 | # greskell-core 2 | 3 | Haskell binding for Gremlin query language. 4 | 5 | See the package description, or [project README](https://github.com/debug-ito/greskell/blob/master/README.md). 6 | 7 | ## Author 8 | 9 | Toshio Ito 10 | -------------------------------------------------------------------------------- /greskell-core/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /greskell-core/greskell-core.cabal: -------------------------------------------------------------------------------- 1 | name: greskell-core 2 | version: 1.0.0.4 3 | author: Toshio Ito 4 | maintainer: Toshio Ito 5 | license: BSD3 6 | license-file: LICENSE 7 | synopsis: Haskell binding for Gremlin graph query language - core data types and tools 8 | description: Haskell binding for [Gremlin graph query language](http://tinkerpop.apache.org/gremlin.html). 9 | See [README.md](https://github.com/debug-ito/greskell/blob/master/README.md) for detail. 10 | . 11 | This package contains only core data types and tools used commonly by other related packages. 12 | category: Data 13 | cabal-version: 2.0 14 | build-type: Simple 15 | extra-source-files: README.md, ChangeLog.md 16 | homepage: https://github.com/debug-ito/greskell/ 17 | bug-reports: https://github.com/debug-ito/greskell/issues/ 18 | 19 | library 20 | default-language: Haskell2010 21 | hs-source-dirs: src 22 | ghc-options: -Wall -fno-warn-unused-imports 23 | -- default-extensions: 24 | other-extensions: OverloadedStrings, TypeFamilies, DeriveGeneric, 25 | GeneralizedNewtypeDeriving, DeriveTraversable 26 | exposed-modules: Data.Greskell.Greskell, 27 | Data.Greskell.GraphSON, 28 | Data.Greskell.GraphSON.GValue, 29 | Data.Greskell.GMap, 30 | Data.Greskell.AsIterator 31 | other-modules: Data.Greskell.GraphSON.GraphSONTyped, 32 | Data.Greskell.GraphSON.Core 33 | build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0, 34 | aeson ^>=2.0.2 || ^>=2.1.0 || ^>=2.2.3, 35 | unordered-containers ^>=0.2.15, 36 | hashable ^>=1.4.0 || ^>=1.5.0, 37 | scientific ^>=0.3.7, 38 | text ^>=1.2.3 || ^>=2.0.2 || ^>=2.1, 39 | semigroups ^>=0.20, 40 | vector ^>=0.12.3 || ^>=0.13.0, 41 | containers ^>=0.6.2 || ^>=0.7, 42 | uuid ^>=1.3.15, 43 | bytestring ^>=0.10.9 || ^>=0.11.3 || ^>=0.12.0 44 | 45 | test-suite spec 46 | type: exitcode-stdio-1.0 47 | default-language: Haskell2010 48 | hs-source-dirs: test 49 | ghc-options: -Wall -fno-warn-unused-imports -fno-warn-incomplete-uni-patterns "-with-rtsopts=-M512m" 50 | main-is: Spec.hs 51 | -- default-extensions: 52 | other-extensions: OverloadedStrings, NoMonomorphismRestriction, CPP 53 | other-modules: Data.Greskell.GreskellSpec, 54 | Data.Greskell.GraphSONSpec, 55 | Data.Greskell.GMapSpec, 56 | Data.Greskell.Test.QuickCheck, 57 | ExamplesSpec 58 | build-tool-depends: hspec-discover:hspec-discover 59 | build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0, 60 | text ^>=1.2.3 || ^>=2.0.2 || ^>=2.1, 61 | aeson ^>=2.0.2 || ^>=2.1.0 || ^>=2.2.3, 62 | unordered-containers ^>=0.2.15, 63 | vector ^>=0.12.3 || ^>=0.13.0, 64 | bytestring ^>=0.10.9 || ^>=0.11.3 || ^>=0.12.0, 65 | greskell-core, 66 | hspec ^>=2.9.1 || ^>=2.10.6 || ^>=2.11.9, 67 | QuickCheck ^>=2.14.2 || ^>=2.15.0 68 | 69 | source-repository head 70 | type: git 71 | location: https://github.com/debug-ito/greskell.git 72 | -------------------------------------------------------------------------------- /greskell-core/src/Data/Greskell/AsIterator.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | -- | 3 | -- Module: Data.Greskell.AsIterator 4 | -- Description: Conversion from Object to Iterator in Gremlin 5 | -- Maintainer: Toshio Ito 6 | -- 7 | -- @since 0.1.2.0 8 | module Data.Greskell.AsIterator 9 | ( AsIterator (..) 10 | ) where 11 | 12 | import qualified Data.HashMap.Lazy as L (HashMap) 13 | import Data.HashSet (HashSet) 14 | import Data.Int (Int16, Int32, Int64, Int8) 15 | import qualified Data.IntMap.Lazy as L (IntMap) 16 | import Data.IntSet (IntSet) 17 | import Data.List.NonEmpty (NonEmpty) 18 | import qualified Data.Map.Lazy as L (Map) 19 | import Data.Ratio (Ratio) 20 | import Data.Scientific (Scientific) 21 | import Data.Sequence (Seq) 22 | import Data.Set (Set) 23 | import Data.Text (Text) 24 | import qualified Data.Text.Lazy as TL 25 | import Data.Vector (Vector) 26 | import Data.Word (Word16, Word32, Word64, Word8) 27 | import Numeric.Natural (Natural) 28 | 29 | import Data.Greskell.GMap (GMap, GMapEntry) 30 | 31 | -- | Types that are converted to an iterator by 32 | -- @org.apache.tinkerpop.gremlin.util.iterator.IteratorUtils.asIterator@ 33 | -- method. In fact, that method can convert any type to an iterator, 34 | -- but greskell limits types to which the conversion is applicable. 35 | -- 36 | -- Associated with this type-class is 'IteratorItem'. 'IteratorItem' 37 | -- type family is association of type @a@ and the type of its item 38 | -- when type @a@ is converted to an iterator. 39 | -- 40 | -- 'IteratorItem' rule of thumb: 41 | -- 42 | -- - @Iterator@ and @Iterable@ types like @List@, @Stream@ and 43 | -- @GraphTraversal@ are converted to their element types. 44 | -- - @Map@ type is converted to its @Map.Entry@. In greskell, 45 | -- @Map.Entry@ is expressed as 'GMapEntry'. 46 | -- - Other types are converted to themselves. 47 | -- 48 | -- Caveat: 49 | -- 50 | -- - Because Haskell's 'String' is @[Char]@, @IteratorItem String@ 51 | -- returns 'Char', which is incorrect. Use 'Text' if you want to 52 | -- deal with @String@s in Gremlin. 53 | class AsIterator a where 54 | type IteratorItem a 55 | 56 | instance AsIterator () where 57 | type IteratorItem () = () 58 | instance AsIterator Int where 59 | type IteratorItem Int = Int 60 | instance AsIterator Text where 61 | type IteratorItem Text = Text 62 | instance AsIterator TL.Text where 63 | type IteratorItem TL.Text = TL.Text 64 | instance AsIterator Bool where 65 | type IteratorItem Bool = Bool 66 | instance AsIterator Char where 67 | type IteratorItem Char = Char 68 | instance AsIterator Double where 69 | type IteratorItem Double = Double 70 | instance AsIterator Float where 71 | type IteratorItem Float = Float 72 | instance AsIterator Int8 where 73 | type IteratorItem Int8 = Int8 74 | instance AsIterator Int16 where 75 | type IteratorItem Int16 = Int16 76 | instance AsIterator Int32 where 77 | type IteratorItem Int32 = Int32 78 | instance AsIterator Int64 where 79 | type IteratorItem Int64 = Int64 80 | instance AsIterator Integer where 81 | type IteratorItem Integer = Integer 82 | instance AsIterator Natural where 83 | type IteratorItem Natural = Natural 84 | instance Integral a => AsIterator (Ratio a) where 85 | type IteratorItem (Ratio a) = Ratio a 86 | instance AsIterator Word where 87 | type IteratorItem Word = Word 88 | instance AsIterator Word8 where 89 | type IteratorItem Word8 = Word8 90 | instance AsIterator Word16 where 91 | type IteratorItem Word16 = Word16 92 | instance AsIterator Word32 where 93 | type IteratorItem Word32 = Word32 94 | instance AsIterator Word64 where 95 | type IteratorItem Word64 = Word64 96 | instance AsIterator Scientific where 97 | type IteratorItem Scientific = Scientific 98 | 99 | instance AsIterator [a] where 100 | type IteratorItem [a] = a 101 | instance AsIterator (Vector a) where 102 | type IteratorItem (Vector a) = a 103 | instance AsIterator (HashSet a) where 104 | type IteratorItem (HashSet a) = a 105 | instance AsIterator (Seq a) where 106 | type IteratorItem (Seq a) = a 107 | instance AsIterator (Set a) where 108 | type IteratorItem (Set a) = a 109 | instance AsIterator IntSet where 110 | type IteratorItem IntSet = Int 111 | -- | @since 0.1.3.0 112 | instance AsIterator (NonEmpty a) where 113 | type IteratorItem (NonEmpty a) = a 114 | 115 | instance AsIterator (GMap c k v) where 116 | type IteratorItem (GMap c k v) = GMapEntry k v 117 | instance AsIterator (GMapEntry k v) where 118 | type IteratorItem (GMapEntry k v) = GMapEntry k v 119 | instance AsIterator (L.HashMap k v) where 120 | type IteratorItem (L.HashMap k v) = GMapEntry k v 121 | instance AsIterator (L.Map k v) where 122 | type IteratorItem (L.Map k v) = GMapEntry k v 123 | instance AsIterator (L.IntMap v) where 124 | type IteratorItem (L.IntMap v) = GMapEntry Int v 125 | 126 | instance AsIterator a => AsIterator (Maybe a) where 127 | type IteratorItem (Maybe a) = Maybe (IteratorItem a) 128 | 129 | -- About encoding of Map.Entry 130 | -- 131 | -- It seems that GraphSON encodes a Map.Entry as if it were a 132 | -- single-entry Map, but who is responsble for that? jackson? 133 | -- 134 | -- Maybe these topics are related? 135 | -- 136 | -- - https://github.com/fasterxml/jackson-databind/issues/565 137 | -- - https://fasterxml.github.io/jackson-databind/javadoc/2.8/com/fasterxml/jackson/databind/ser/impl/MapEntrySerializer.html 138 | -------------------------------------------------------------------------------- /greskell-core/src/Data/Greskell/GraphSON/Core.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | -- | 4 | -- Module: Data.Greskell.GraphSON.Core 5 | -- Description: 6 | -- Maintainer: Toshio Ito 7 | -- 8 | -- __Internal module.__ Definition of 'GraphSON' type. 9 | module Data.Greskell.GraphSON.Core 10 | ( GraphSON (..) 11 | , nonTypedGraphSON 12 | , typedGraphSON 13 | , typedGraphSON' 14 | , parseTypedGraphSON 15 | , parseTypedGraphSON' 16 | ) where 17 | 18 | import Control.Applicative ((<$>), (<*>)) 19 | import Control.Monad (when) 20 | import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), 21 | Value (..), object, (.=)) 22 | import qualified Data.Aeson as Aeson 23 | import Data.Aeson.Types (Parser) 24 | import Data.Foldable (Foldable (foldr)) 25 | import Data.Hashable (Hashable (..)) 26 | import Data.Text (Text) 27 | import Data.Traversable (Traversable (traverse)) 28 | import GHC.Generics (Generic) 29 | 30 | import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped (..)) 31 | 32 | -- | Wrapper for \"typed JSON object\" introduced in GraphSON version 33 | -- 2. See http://tinkerpop.apache.org/docs/current/dev/io/#graphson 34 | -- 35 | -- This data type is useful for encoding/decoding GraphSON text. 36 | -- 37 | -- Note that encoding of the \"g:Map\" type is inconsistent between 38 | -- GraphSON v1 and v2, v3. To handle the encoding, use 39 | -- "Data.Greskell.GMap". 40 | data GraphSON v 41 | = GraphSON 42 | { gsonType :: Maybe Text 43 | -- ^ Type ID, corresponding to @\@type@ field. 44 | , gsonValue :: v 45 | -- ^ Value, correspoding to @\@value@ field. 46 | } 47 | deriving (Eq, Generic, Ord, Show) 48 | 49 | instance Functor GraphSON where 50 | fmap f gs = gs { gsonValue = f $ gsonValue gs } 51 | 52 | instance Foldable GraphSON where 53 | foldr f start gs = f (gsonValue gs) start 54 | 55 | instance Traversable GraphSON where 56 | traverse f gs = fmap (\v -> gs { gsonValue = v }) $ f $ gsonValue gs 57 | 58 | -- | @since 0.1.2.0 59 | instance Hashable v => Hashable (GraphSON v) 60 | 61 | -- | If 'gsonType' is 'Just', the 'GraphSON' is encoded as a typed 62 | -- JSON object. If 'gsonType' is 'Nothing', the 'gsonValue' is 63 | -- directly encoded. 64 | instance ToJSON v => ToJSON (GraphSON v) where 65 | toJSON gson = case gsonType gson of 66 | Nothing -> toJSON $ gsonValue gson 67 | Just t -> object [ "@type" .= t, 68 | "@value" .= gsonValue gson 69 | ] 70 | 71 | -- | If the given 'Value' is a typed JSON object, 'gsonType' field of 72 | -- the result is 'Just'. Otherwise, the given 'Value' is directly 73 | -- parsed into 'gsonValue', and 'gsonType' is 'Nothing'. 74 | instance FromJSON v => FromJSON (GraphSON v) where 75 | parseJSON v@(Object o) = do 76 | if length o /= 2 77 | then parseDirect v 78 | else do 79 | mtype <- o Aeson..:! "@type" 80 | mvalue <- o Aeson..:! "@value" 81 | maybe (parseDirect v) return $ typedGraphSON' <$> mtype <*> mvalue 82 | parseJSON v = parseDirect v 83 | 84 | parseDirect :: FromJSON v => Value -> Parser (GraphSON v) 85 | parseDirect v = GraphSON Nothing <$> parseJSON v 86 | 87 | 88 | -- | Create a 'GraphSON' without 'gsonType'. 89 | nonTypedGraphSON :: v -> GraphSON v 90 | nonTypedGraphSON = GraphSON Nothing 91 | 92 | -- | Create a 'GraphSON' with its type ID. 93 | typedGraphSON :: GraphSONTyped v => v -> GraphSON v 94 | typedGraphSON v = GraphSON (Just $ gsonTypeFor v) v 95 | 96 | -- | Create a 'GraphSON' with the given type ID. 97 | typedGraphSON' :: Text -> v -> GraphSON v 98 | typedGraphSON' t = GraphSON (Just t) 99 | 100 | 101 | -- | Parse @GraphSON v@, but it checks 'gsonType'. If 'gsonType' is 102 | -- 'Nothing' or it's not equal to 'gsonTypeFor', the 'Parser' fails. 103 | parseTypedGraphSON :: (GraphSONTyped v, FromJSON v) => Value -> Parser (GraphSON v) 104 | parseTypedGraphSON v = either fail return =<< parseTypedGraphSON' v 105 | 106 | -- | Note: this function is not exported because I don't need it for 107 | -- now. If you need this function, just open an issue. 108 | -- 109 | -- Like 'parseTypedGraphSON', but this handles parse errors in a finer 110 | -- granularity. 111 | -- 112 | -- - If the given 'Value' is not a typed JSON object, it returns 113 | -- 'Left'. 114 | -- - If the given 'Value' is a typed JSON object but it fails to parse 115 | -- the \"\@value\" field, the 'Parser' fails. 116 | -- - If the given 'Value' is a typed JSON object but the \"\@type\" 117 | -- field is not equal to the 'gsonTypeFor' of type @v@, the 'Parser' 118 | -- fails. 119 | -- - Otherwise (if the given 'Value' is a typed JSON object with valid 120 | -- \"\@type\" and \"\@value\" fields,) it returns 'Right'. 121 | parseTypedGraphSON' :: (GraphSONTyped v, FromJSON v) => Value -> Parser (Either String (GraphSON v)) 122 | parseTypedGraphSON' v = do 123 | graphsonv <- parseGraphSONPlain v 124 | case gsonType graphsonv of 125 | Nothing -> return $ Left ("Not a valid typed JSON object.") 126 | Just got_type -> do 127 | goal <- parseJSON $ gsonValue graphsonv 128 | let exp_type = gsonTypeFor goal 129 | when (got_type /= exp_type) $ do 130 | fail ("Expected @type of " ++ show exp_type ++ ", but got " ++ show got_type) 131 | return $ Right $ graphsonv { gsonValue = goal } 132 | where 133 | parseGraphSONPlain :: Value -> Parser (GraphSON Value) 134 | parseGraphSONPlain = parseJSON 135 | -------------------------------------------------------------------------------- /greskell-core/src/Data/Greskell/GraphSON/GValue.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | -- | 3 | -- Module: Data.Greskell.GraphSON.GValue 4 | -- Description: Aeson Value with GraphSON wrappers 5 | -- Maintainer: Toshio Ito 6 | -- 7 | -- __This module is for advanced use. Most users should just use "Data.Greskell.GraphSON".__ 8 | -- 9 | -- This module defines 'GValue' and exposes its deconstructors. 10 | -- 11 | -- @since 0.1.2.0 12 | module Data.Greskell.GraphSON.GValue 13 | ( -- * GValue type 14 | GValue (..) 15 | , GValueBody (..) 16 | -- ** constructors 17 | , nonTypedGValue 18 | , typedGValue' 19 | -- ** deconstructors 20 | -- $caveat_decon 21 | , unwrapAll 22 | , unwrapOne 23 | , gValueBody 24 | , gValueType 25 | ) where 26 | 27 | import Control.Applicative ((<$>), (<*>)) 28 | import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (..)) 29 | import Data.Aeson.KeyMap (KeyMap) 30 | import Data.Aeson.Types (Parser) 31 | import Data.Foldable (foldl') 32 | import Data.Hashable (Hashable (..)) 33 | import Data.HashMap.Strict (HashMap) 34 | import Data.Scientific (Scientific) 35 | import Data.Text (Text) 36 | import Data.Vector (Vector) 37 | import GHC.Generics (Generic) 38 | 39 | import Data.Greskell.GraphSON.Core (GraphSON (..), nonTypedGraphSON, typedGraphSON') 40 | 41 | -- | An Aeson 'Value' wrapped in 'GraphSON' wrapper type. Basically 42 | -- this type is the Haskell representaiton of a GraphSON-encoded 43 | -- document. 44 | -- 45 | -- This type is used to parse GraphSON documents. See also 46 | -- 'Data.Greskell.GraphSON.FromGraphSON' class. 47 | -- 48 | -- @since 0.1.2.0 49 | newtype GValue 50 | = GValue { unGValue :: GraphSON GValueBody } 51 | deriving (Eq, Generic, Show) 52 | 53 | instance Hashable GValue 54 | 55 | -- | 'GValue' without the top-level 'GraphSON' wrapper. 56 | -- 57 | -- @since 1.0.0.0 58 | data GValueBody 59 | = GObject !(KeyMap GValue) 60 | | GArray !(Vector GValue) 61 | | GString !Text 62 | | GNumber !Scientific 63 | | GBool !Bool 64 | | GNull 65 | deriving (Eq, Generic, Show) 66 | 67 | instance Hashable GValueBody where 68 | -- See Data.Aeson.Types.Internal 69 | hashWithSalt s (GObject o) = s `hashWithSalt` (0::Int) `hashWithSalt` o 70 | hashWithSalt s (GArray a) = foldl' hashWithSalt (s `hashWithSalt` (1::Int)) a 71 | hashWithSalt s (GString str) = s `hashWithSalt` (2::Int) `hashWithSalt` str 72 | hashWithSalt s (GNumber n) = s `hashWithSalt` (3::Int) `hashWithSalt` n 73 | hashWithSalt s (GBool b) = s `hashWithSalt` (4::Int) `hashWithSalt` b 74 | hashWithSalt s GNull = s `hashWithSalt` (5::Int) 75 | 76 | -- | Parse 'GraphSON' wrappers recursively in 'Value', making it into 77 | -- 'GValue'. 78 | instance FromJSON GValue where 79 | parseJSON input = do 80 | gv <- parseJSON input 81 | recursed_value <- recurse $ gsonValue gv 82 | return $ GValue $ gv { gsonValue = recursed_value } 83 | where 84 | recurse :: Value -> Parser GValueBody 85 | recurse (Object o) = GObject <$> traverse parseJSON o 86 | recurse (Array a) = GArray <$> traverse parseJSON a 87 | recurse (String s) = return $ GString s 88 | recurse (Number n) = return $ GNumber n 89 | recurse (Bool b) = return $ GBool b 90 | recurse Null = return GNull 91 | 92 | -- | Reconstruct 'Value' from 'GValue'. It preserves all GraphSON 93 | -- wrappers. 94 | instance ToJSON GValue where 95 | toJSON (GValue gson_body) = toJSON $ fmap toJSON gson_body 96 | 97 | instance ToJSON GValueBody where 98 | toJSON (GObject o) = toJSON o 99 | toJSON (GArray a) = toJSON a 100 | toJSON (GString s) = String s 101 | toJSON (GNumber n) = Number n 102 | toJSON (GBool b) = Bool b 103 | toJSON GNull = Null 104 | 105 | -- | Create a 'GValue' without \"@type\" field. 106 | -- 107 | -- @since 0.1.2.0 108 | nonTypedGValue :: GValueBody -> GValue 109 | nonTypedGValue = GValue . nonTypedGraphSON 110 | 111 | -- | Create a 'GValue' with the given \"@type\" field. 112 | -- 113 | -- @since 0.1.2.0 114 | typedGValue' :: Text -- ^ \"@type\" field. 115 | -> GValueBody -> GValue 116 | typedGValue' t b = GValue $ typedGraphSON' t b 117 | 118 | 119 | -- $caveat_decon 120 | -- 121 | -- __In most cases, you should not use these deconstructors.__ That is 122 | -- because internal structure of 'GValue' may vary depending on the 123 | -- Gremlin server instance and its serializer. You should instead use 124 | -- parsers based on 'Data.Greskell.GraphSON.FromGraphSON' class, such 125 | -- as 'Data.Greskell.GraphSON.parseEither'. 126 | -- 127 | -- If you are implementing parsers for GraphSON objects described in 128 | -- Gremlin IO Reference 129 | -- (), you may use 130 | -- these descructors. 131 | -- 132 | 133 | -- | Remove all 'GraphSON' wrappers recursively from 'GValue'. 134 | -- 135 | -- @since 0.1.2.0 136 | unwrapAll :: GValue -> Value 137 | unwrapAll = unwrapBase unwrapAll 138 | 139 | -- | Remove the top-level 'GraphSON' wrapper, but leave other wrappers 140 | -- as-is. The remaining wrappers are reconstructed by 'toJSON' to make 141 | -- them into 'Value'. 142 | -- 143 | -- @since 0.1.2.0 144 | unwrapOne :: GValue -> Value 145 | unwrapOne = unwrapBase toJSON 146 | 147 | unwrapBase :: (GValue -> Value) -> GValue -> Value 148 | unwrapBase mapChild (GValue gson_body) = unwrapBody $ gsonValue gson_body 149 | where 150 | unwrapBody GNull = Null 151 | unwrapBody (GBool b) = Bool b 152 | unwrapBody (GNumber n) = Number n 153 | unwrapBody (GString s) = String s 154 | unwrapBody (GArray a) = Array $ fmap mapChild a 155 | unwrapBody (GObject o) = Object $ fmap mapChild o 156 | 157 | -- | Get the 'GValueBody' from 'GValue'. 158 | -- 159 | -- @since 0.1.2.0 160 | gValueBody :: GValue -> GValueBody 161 | gValueBody = gsonValue . unGValue 162 | 163 | -- | Get the 'gsonType' field from 'GValue'. 164 | -- 165 | -- @since 0.1.2.0 166 | gValueType :: GValue -> Maybe Text 167 | gValueType = gsonType . unGValue 168 | -------------------------------------------------------------------------------- /greskell-core/src/Data/Greskell/GraphSON/GraphSONTyped.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | 3 | -- Module: Data.Greskell.GraphSON.GraphSONTyped 4 | -- Description: 5 | -- Maintainer: Toshio Ito 6 | -- 7 | -- __Internal module.__ Just to resolve cyclic dependency between 8 | -- GraphSON and GMap. 9 | module Data.Greskell.GraphSON.GraphSONTyped 10 | ( GraphSONTyped (..) 11 | ) where 12 | 13 | import qualified Data.HashMap.Lazy as L (HashMap) 14 | import qualified Data.HashMap.Strict as S (HashMap) 15 | import Data.HashSet (HashSet) 16 | import Data.Int (Int16, Int32, Int64, Int8) 17 | import qualified Data.IntMap.Lazy as L (IntMap) 18 | import qualified Data.IntMap.Strict as S (IntMap) 19 | import Data.IntSet (IntSet) 20 | import qualified Data.Map.Lazy as L (Map) 21 | import qualified Data.Map.Strict as S (Map) 22 | import Data.Scientific (Scientific) 23 | import Data.Sequence (Seq) 24 | import Data.Set (Set) 25 | import Data.Text (Text) 26 | import Data.Vector (Vector) 27 | 28 | 29 | -- | Types that have an intrinsic type ID for 'gsonType' field. 30 | class GraphSONTyped a where 31 | gsonTypeFor :: a -> Text 32 | -- ^ Type ID for 'gsonType'. 33 | 34 | instance GraphSONTyped Char where 35 | gsonTypeFor _ = "gx:Char" 36 | 37 | -- | Map to \"gx:Byte\". Note that Java's Byte is signed. 38 | instance GraphSONTyped Int8 where 39 | gsonTypeFor _ = "gx:Byte" 40 | 41 | instance GraphSONTyped Int16 where 42 | gsonTypeFor _ = "gx:Int16" 43 | 44 | instance GraphSONTyped Int32 where 45 | gsonTypeFor _ = "g:Int32" 46 | 47 | instance GraphSONTyped Int64 where 48 | gsonTypeFor _ = "g:Int64" 49 | 50 | instance GraphSONTyped Float where 51 | gsonTypeFor _ = "g:Float" 52 | 53 | instance GraphSONTyped Double where 54 | gsonTypeFor _ = "g:Double" 55 | 56 | instance GraphSONTyped [a] where 57 | gsonTypeFor _ = "g:List" 58 | 59 | -- | @since 0.1.2.0 60 | instance GraphSONTyped (Vector a) where 61 | gsonTypeFor _ = "g:List" 62 | 63 | -- | @since 0.1.2.0 64 | instance GraphSONTyped (Seq a) where 65 | gsonTypeFor _ = "g:List" 66 | 67 | -- | Map to \"g:Double\". 68 | instance GraphSONTyped Scientific where 69 | gsonTypeFor _ = "g:Double" 70 | 71 | instance GraphSONTyped (HashSet a) where 72 | gsonTypeFor _ = "g:Set" 73 | 74 | -- | @since 0.1.2.0 75 | instance GraphSONTyped IntSet where 76 | gsonTypeFor _ = "g:Set" 77 | 78 | -- | @since 0.1.2.0 79 | instance GraphSONTyped (Set a) where 80 | gsonTypeFor _ = "g:Set" 81 | 82 | instance GraphSONTyped (L.HashMap k v) where 83 | gsonTypeFor _ = "g:Map" 84 | 85 | -- | @since 0.1.2.0 86 | instance GraphSONTyped (L.Map k v) where 87 | gsonTypeFor _= "g:Map" 88 | 89 | -- | @since 0.1.2.0 90 | instance GraphSONTyped (L.IntMap v) where 91 | gsonTypeFor _= "g:Map" 92 | 93 | -- -- Implementation of Lazy and Strict types are the same. 94 | -- 95 | -- instance GraphSONTyped (S.HashMap k v) where 96 | -- gsonTypeFor _ = "g:Map" 97 | -- 98 | -- instance GraphSONTyped (S.Map k v) where 99 | -- gsonTypeFor _= "g:Map" 100 | -- 101 | -- instance GraphSONTyped (S.IntMap v) where 102 | -- gsonTypeFor _= "g:Map" 103 | 104 | -- | @since 0.1.2.0 105 | instance (GraphSONTyped a, GraphSONTyped b) => GraphSONTyped (Either a b) where 106 | gsonTypeFor e = either gsonTypeFor gsonTypeFor e 107 | -------------------------------------------------------------------------------- /greskell-core/test/Data/Greskell/GMapSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Data.Greskell.GMapSpec 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import Data.Aeson (Value (..), eitherDecode, object, toJSON, (.=)) 8 | import qualified Data.Aeson.KeyMap as KM 9 | import Data.HashMap.Strict (HashMap) 10 | import qualified Data.HashMap.Strict as HM 11 | import Data.List (isInfixOf) 12 | import Data.Monoid (mempty) 13 | import Data.Vector (Vector, (!)) 14 | import qualified Data.Vector as Vec 15 | import Test.Hspec 16 | 17 | import Data.Greskell.GMap (FlattenedMap, GMap (..), GMapEntry (..)) 18 | import Data.Greskell.GraphSON (GraphSON (..), nonTypedGraphSON, typedGraphSON) 19 | 20 | main :: IO () 21 | main = hspec spec 22 | 23 | spec :: Spec 24 | spec = do 25 | spec_FlattenedMap 26 | spec_GMap 27 | spec_GMapEntry 28 | 29 | spec_FlattenedMap :: Spec 30 | spec_FlattenedMap = describe "FlattenedMap" $ do 31 | specify "decode an array with odd number of elements" $ do 32 | let got :: Either String (FlattenedMap HashMap Int String) 33 | got = eitherDecode "[10, \"ten\", 11]" 34 | case got of 35 | Right _ -> expectationFailure ("should be Left, but got " ++ show got) 36 | Left err -> err `shouldContain` "odd number of elements" 37 | 38 | spec_GMap :: Spec 39 | spec_GMap = describe "GraphSON GMap" $ do 40 | describe "non-flat" $ do 41 | let val :: GraphSON (GMap HashMap String Int) 42 | val = nonTypedGraphSON $ GMap False $ HM.fromList [("foo", 3), ("bar", 5), ("a", 1)] 43 | specify "FromJSON" $ do 44 | let input = "{\"foo\":3, \"a\": 1, \"bar\": 5}" 45 | eitherDecode input `shouldBe` Right val 46 | specify "ToJSON" $ do 47 | let expected = object [ "foo" .= Number 3, 48 | "bar" .= Number 5, 49 | "a" .= Number 1 50 | ] 51 | toJSON val `shouldBe` expected 52 | specify "FromJSON empty" $ do 53 | let val_empty :: GraphSON (GMap HashMap String Int) 54 | val_empty = nonTypedGraphSON $ GMap False mempty 55 | eitherDecode "{}" `shouldBe` Right val_empty 56 | describe "flat" $ do 57 | let val :: GraphSON (GMap HashMap String Int) 58 | val = typedGraphSON $ GMap True $ HM.fromList [("foo", 3), ("bar", 5), ("a", 1)] 59 | specify "FromJSON" $ do 60 | let input = "{\"@type\": \"g:Map\", \"@value\": [\"a\", 1, \"bar\", 5, \"foo\", 3]}" 61 | eitherDecode input `shouldBe` Right val 62 | specify "ToJSON" $ do 63 | let exp_flat = Vec.fromList [ String "foo", Number 3, 64 | String "bar", Number 5, 65 | String "a", Number 1 66 | ] 67 | (Object got) = toJSON val 68 | KM.lookup "@type" got `shouldBe` (Just $ String "g:Map") 69 | let (Just (Array got_flat)) = KM.lookup "@value" got 70 | pairList got_flat `shouldMatchList` pairList exp_flat 71 | specify "FromJSON empty" $ do 72 | let val_empty :: GraphSON (GMap HashMap String Int) 73 | val_empty = typedGraphSON $ GMap True mempty 74 | eitherDecode "{\"@type\": \"g:Map\", \"@value\": []}" `shouldBe` Right val_empty 75 | 76 | pairList :: Vector Value -> [(Value,Value)] 77 | pairList a = map toPair $ [0 .. imax] 78 | where 79 | imax = (Vec.length a `div` 2) - 1 80 | toPair i = (a ! (i*2), a ! (i*2 + 1)) 81 | 82 | expLeft :: Show a => Either String a -> (String -> Bool) -> IO () 83 | expLeft e@(Right _) _ = expectationFailure ("expects Left, but got " ++ show e) 84 | expLeft (Left e) p = e `shouldSatisfy` p 85 | 86 | spec_GMapEntry :: Spec 87 | spec_GMapEntry = describe "GMapEntry" $ do 88 | specify "zero entry" $ do 89 | let got :: Either String (GMapEntry String Int) 90 | got = eitherDecode "[]" 91 | got `expLeft` ("0 entries" `isInfixOf`) 92 | specify "two entries" $ do 93 | let got :: Either String (GMapEntry String Int) 94 | got = eitherDecode "{\"foo\": 10, \"bar\": 20}" 95 | got `expLeft` ("Unexpected structure" `isInfixOf`) 96 | -------------------------------------------------------------------------------- /greskell-core/test/Data/Greskell/GreskellSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Data.Greskell.GreskellSpec 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import qualified Data.Aeson as Aeson 8 | import Data.String (fromString) 9 | import Data.Text (Text, pack) 10 | import Test.Hspec 11 | import Test.QuickCheck (property) 12 | 13 | import Data.Greskell.Greskell (Greskell, false, list, number, string, toGremlin, 14 | true, unsafeFunCall, unsafeGreskell, value) 15 | 16 | import Data.Greskell.Test.QuickCheck () 17 | 18 | main :: IO () 19 | main = hspec spec 20 | 21 | spec :: Spec 22 | spec = do 23 | spec_literals 24 | spec_other 25 | 26 | spec_other :: Spec 27 | spec_other = do 28 | describe "unsafeGreskell" $ it "should be just a raw script text" $ property $ \t -> 29 | (toGremlin $ unsafeGreskell t) `shouldBe` t 30 | describe "Num" $ do 31 | specify "integer" $ do 32 | let x = 123 :: Greskell Int 33 | toGremlin x `shouldBe` "123" 34 | specify "negative integer" $ do 35 | let x = -56 :: Greskell Int 36 | toGremlin x `shouldBe` "-(56)" 37 | specify "operations" $ do 38 | let x = (30 + 15 * 20 - 10) :: Greskell Int 39 | toGremlin x `shouldBe` "((30)+((15)*(20)))-(10)" 40 | specify "abs, signum" $ do 41 | let x = (signum $ abs (-100)) :: Greskell Int 42 | toGremlin x `shouldBe` "java.lang.Long.signum(java.lang.Math.abs(-(100)))" 43 | describe "Fractional" $ do 44 | specify "floating point literal" $ do 45 | let x = 92.12 :: Greskell Double 46 | (toGremlin x) `shouldBe` "2303.0/25" 47 | specify "operations" $ do 48 | let x = (100.5 * recip 30.0 / 20.2) :: Greskell Double 49 | toGremlin x `shouldBe` "((201.0/2)*(1.0/(30.0/1)))/(101.0/5)" 50 | describe "Monoid" $ do 51 | specify "mempty" $ do 52 | let got = mempty :: Greskell Text 53 | toGremlin got `shouldBe` "\"\"" 54 | specify "mappend" $ do 55 | let got = (mappend "foo" "bar") :: Greskell Text 56 | toGremlin got `shouldBe` "(\"foo\")+(\"bar\")" 57 | describe "unsafeFunCall" $ do 58 | it "should make function call" $ do 59 | (toGremlin $ unsafeFunCall "fun" ["foo", "bar"]) `shouldBe` "fun(foo,bar)" 60 | 61 | spec_literals :: Spec 62 | spec_literals = do 63 | describe "string and fromString" $ do 64 | specify "empty" $ checkStringLiteral "" "\"\"" 65 | specify "words" $ checkStringLiteral "hoge foo bar" "\"hoge foo bar\"" 66 | specify "escaped" $ checkStringLiteral "foo 'aaa \n \t \\ \"bar\"" "\"foo 'aaa \\n \\t \\\\ \\\"bar\\\"\"" 67 | describe "list" $ do 68 | specify "empty" $ do 69 | toGremlin (list []) `shouldBe` "[]" 70 | specify "num" $ do 71 | toGremlin (list $ [(10 :: Greskell Int), 20, 30]) `shouldBe` "[10,20,30]" 72 | specify "list of lists" $ do 73 | toGremlin (list $ map list $ [[("" :: Greskell Text)], ["foo", "bar"], ["buzz"]]) 74 | `shouldBe` "[[\"\"],[\"foo\",\"bar\"],[\"buzz\"]]" 75 | describe "boolean" $ do 76 | specify "true" $ do 77 | toGremlin true `shouldBe` "true" 78 | specify "false" $ do 79 | toGremlin false `shouldBe` "false" 80 | describe "number" $ do 81 | specify "zero" $ do 82 | toGremlin (number 0) `shouldBe` "0.0" 83 | specify "positive integer" $ do 84 | toGremlin (number 1234) `shouldBe` "1234.0" 85 | specify "negative integer" $ do 86 | toGremlin (number (-292)) `shouldBe` "-292.0" 87 | specify "positive floating" $ do 88 | toGremlin (number 32.123) `shouldBe` "32.123" 89 | specify "negative floating" $ do 90 | toGremlin (number (-0.0943)) `shouldBe` "-9.43e-2" 91 | specify "big positive integer" $ do 92 | toGremlin (number 3.23e9) `shouldBe` "3.23e9" 93 | describe "value" $ do 94 | specify "null" $ do 95 | toGremlin (value Aeson.Null) `shouldBe` "null" 96 | specify "bool" $ do 97 | toGremlin (value $ Aeson.Bool False) `shouldBe` "false" 98 | specify "integer" $ do 99 | toGremlin (value $ Aeson.Number 100) `shouldBe` "100.0" 100 | specify "floating-point number" $ do 101 | toGremlin (value $ Aeson.Number 10.23) `shouldBe` "10.23" 102 | specify "String" $ do 103 | toGremlin (value $ Aeson.String "foobar") `shouldBe` "\"foobar\"" 104 | specify "empty Array" $ do 105 | toGremlin (value $ Aeson.toJSON ([] :: [Int])) `shouldBe` "[]" 106 | specify "non-empty Array" $ do 107 | toGremlin (value $ Aeson.toJSON [(5 :: Int), 6, 7]) `shouldBe` "[5.0,6.0,7.0]" 108 | specify "empty Object" $ do 109 | toGremlin (value $ Aeson.object []) `shouldBe` "[:]" 110 | 111 | 112 | checkStringLiteral :: String -> Text -> Expectation 113 | checkStringLiteral input expected = do 114 | let input' = fromString input :: Greskell Text 115 | (toGremlin $ input') `shouldBe` expected 116 | (toGremlin $ string $ pack input) `shouldBe` expected 117 | -------------------------------------------------------------------------------- /greskell-core/test/Data/Greskell/Test/QuickCheck.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | -- | QuickCheck orphan instances and other utility. 3 | module Data.Greskell.Test.QuickCheck 4 | ( 5 | ) where 6 | 7 | import Data.Text (Text, pack) 8 | import Test.QuickCheck (Arbitrary (..)) 9 | 10 | instance Arbitrary Text where 11 | arbitrary = fmap pack arbitrary 12 | 13 | 14 | -------------------------------------------------------------------------------- /greskell-core/test/ExamplesSpec.hs: -------------------------------------------------------------------------------- 1 | module ExamplesSpec 2 | ( main 3 | , spec 4 | ) where 5 | 6 | import qualified Data.Greskell.GMap as GMap 7 | import qualified Data.Greskell.GraphSON as GraphSON 8 | import qualified Data.Greskell.Greskell as Greskell 9 | 10 | import Control.Monad (forM_) 11 | import Test.Hspec 12 | 13 | main :: IO () 14 | main = hspec spec 15 | 16 | spec :: Spec 17 | spec = describe "examples" $ do 18 | makeSpec "GraphSON" GraphSON.examples 19 | makeSpec "Greskell" Greskell.examples 20 | makeSpec "GMap" GMap.examples 21 | 22 | makeSpec :: (Show a) => String -> [(a, a)] -> Spec 23 | makeSpec label exs = describe label $ forM_ exs $ \(got, expected) -> specify (show expected) $ show got `shouldBe` show expected 24 | -------------------------------------------------------------------------------- /greskell-core/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /greskell-websocket/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for greskell-websocket 2 | 3 | ## 1.0.0.4 -- 2025-01-30 4 | 5 | * Fix the bug where greskell-websocket didn't work at all with `async-2.2.5`. (see https://github.com/debug-ito/greskell/pull/17 ) 6 | * Support ghc-9.12 (base-4.21). 7 | 8 | ## 1.0.0.3 -- 2024-11-21 9 | 10 | * Confirm test with `hashtable-1.4`. 11 | 12 | ## 1.0.0.2 -- 2024-09-12 13 | 14 | * Update dependency version bounds with cabal-plan-bounds. 15 | This adds support for new packages, while drops support for old ones. 16 | 17 | ## 1.0.0.1 -- 2022-11-24 18 | 19 | * Confirm test with ghc-9.2.5, vector-0.13.0.0 and aeson-2.1.0.0. 20 | * Remove doctests. This is because it's so difficult to maintain doctests with recent GHCs and cabals. 21 | * doctests have been moved to `examples` function defined in some modules. 22 | * Use stylish-haskell to format codes. 23 | 24 | ## 1.0.0.0 -- 2021-12-28 25 | 26 | * **BREAKING CHANGE**: Now greskell-websocket uses `aeson-2`. 27 | As a result, now implementation of `Data.Aeson.Object` has been changed from `HashMap` to `KeyMap`. 28 | Some types in greskell-websocket (e.g. `ResponseResult`) directly uses the `Object` type. 29 | 30 | * Confirm test with `aeson-2.0.2.0`, `hashtables-1.3`, `greskell-core-1.0`. 31 | 32 | ## 0.1.2.6 -- 2021-11-08 33 | 34 | * Confirm test with `base-4.15.0.0` 35 | 36 | ## 0.1.2.5 -- 2020-12-30 37 | 38 | * Confirm test with `base64-bytestring-1.2.0.0` 39 | 40 | ## 0.1.2.4 -- 2020-06-21 41 | 42 | * Confirm test with `base-4.14.0.0`. 43 | 44 | ## 0.1.2.3 -- 2020-05-30 45 | 46 | * Support `aeson-1.5.0.0`. 47 | 48 | ## 0.1.2.2 -- 2020-05-04 49 | 50 | * Confirm test with `base64-bytestring-1.1.0.0`. 51 | 52 | ## 0.1.2.1 -- 2019-12-30 53 | 54 | * Confirm test with `base-4.13.0.0` 55 | 56 | ## 0.1.2.0 -- 2019-12-27 57 | 58 | * Add `submitPair` function to Client module. 59 | 60 | ## 0.1.1.2 -- 2018-10-03 61 | 62 | * Confirm test with `base-4.12.0.0` 63 | 64 | 65 | ## 0.1.1.1 -- 2018-09-23 66 | 67 | * Confirm test with `stm-2.5.0.0`. 68 | 69 | 70 | ## 0.1.1.0 -- 2018-08-17 71 | 72 | ### Client module 73 | 74 | * Add `drainResults` function. 75 | 76 | ### Connection module 77 | 78 | * Add `drainResponses` function. 79 | 80 | 81 | ## 0.1.0.0 -- 2018-06-21 82 | 83 | * First version. Released on an unsuspecting world. 84 | -------------------------------------------------------------------------------- /greskell-websocket/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Toshio Ito 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Toshio Ito nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /greskell-websocket/README.md: -------------------------------------------------------------------------------- 1 | # greskell-websocket 2 | 3 | 4 | ## Author 5 | 6 | Toshio Ito 7 | -------------------------------------------------------------------------------- /greskell-websocket/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket 3 | -- Description: Client of Gremlin Server using WebSocket 4 | -- Maintainer: Toshio Ito 5 | -- 6 | module Network.Greskell.WebSocket 7 | ( -- $doc 8 | module Network.Greskell.WebSocket.Client 9 | ) where 10 | 11 | import Network.Greskell.WebSocket.Client 12 | 13 | -- $doc 14 | -- 15 | -- Client for Gremlin Server using the WebSocket serializer. For 16 | -- example, see the project 17 | -- [README.md](https://github.com/debug-ito/greskell#submit-to-the-gremlin-server) 18 | -- 19 | -- End-users usually only have to use 20 | -- "Network.Greskell.WebSocket.Client", so this module re-exports only 21 | -- that module. 22 | -- 23 | -- Other modules are low-level implementation and for advanced uses. 24 | -- 25 | -- - "Network.Greskell.WebSocket.Connection": Connection to the 26 | -- Gremlin Server implementing the Driver protocol described in 27 | -- . 28 | -- - "Network.Greskell.WebSocket.Codec": Encoder and decoder of 29 | -- RequestMessage and ResponseMessage. 30 | -- - "Network.Greskell.WebSocket.Request": RequestMessage object sent 31 | -- to Gremlin Server. 32 | -- - "Network.Greskell.WebSocket.Request.Standard": Request objects 33 | -- for Standard OpProcessor. 34 | -- - "Network.Greskell.WebSocket.Request.Session": Request objects for 35 | -- Session OpProcessor. 36 | -- - "Network.Greskell.WebSocket.Response": ResponseMessage object 37 | -- returned from Gremlin Server. 38 | 39 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Client.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket.Client 3 | -- Description: High-level interface to Gremlin Server 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- 7 | module Network.Greskell.WebSocket.Client 8 | ( -- * Make a Client 9 | connect 10 | , connectWith 11 | , close 12 | , Client 13 | , Host 14 | , Port 15 | -- ** Options for Client 16 | , module Network.Greskell.WebSocket.Client.Options 17 | -- * Submit evaluation requests 18 | , submit 19 | , submitPair 20 | , submitRaw 21 | , ResultHandle 22 | , nextResult 23 | , nextResultSTM 24 | , slurpResults 25 | , drainResults 26 | -- * Exceptions 27 | , SubmitException (..) 28 | ) where 29 | 30 | import Network.Greskell.WebSocket.Client.Impl 31 | import Network.Greskell.WebSocket.Client.Options 32 | import Network.Greskell.WebSocket.Connection (Host, Port) 33 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Client/Options.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket.Client.Options 3 | -- Description: Options to create a Client 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- 7 | module Network.Greskell.WebSocket.Client.Options 8 | ( -- * Options 9 | Options 10 | , defOptions 11 | -- ** accessor functions 12 | , connectionSettings 13 | , batchSize 14 | , language 15 | , aliases 16 | , scriptEvaluationTimeout 17 | -- * Settings 18 | , module Network.Greskell.WebSocket.Connection.Settings 19 | ) where 20 | 21 | import Data.Greskell.GraphSON (GValue) 22 | import Data.HashMap.Strict (HashMap) 23 | import Data.Text (Text) 24 | 25 | import Network.Greskell.WebSocket.Connection (Connection) 26 | import Network.Greskell.WebSocket.Connection.Settings 27 | 28 | -- | Configuration options to create a client for Gremlin Server. 29 | -- 30 | -- You can get the default 'Options' by 'defOptions' function, and 31 | -- customize its fields by accessor functions. 32 | data Options 33 | = Options 34 | { connectionSettings :: !(Settings GValue) 35 | -- ^ Settings for the underlying 'Connection'. Default: 36 | -- 'defJSONSettings'. 37 | , batchSize :: !(Maybe Int) 38 | -- ^ \"batchSize\" field for \"eval\" operation. Default: 39 | -- 'Nothing'. 40 | , language :: !(Maybe Text) 41 | -- ^ \"language\" field for \"eval\" operation. Default: 42 | -- 'Nothing'. 43 | , aliases :: !(Maybe (HashMap Text Text)) 44 | -- ^ \"aliases\" field for \"eval\" operation. Default: 'Nothing'. 45 | , scriptEvaluationTimeout :: !(Maybe Int) 46 | -- ^ \"scriptEvaluationTimeout\" field for \"eval\" 47 | -- operation. Default: 'Nothing'. 48 | } 49 | 50 | defOptions :: Options 51 | defOptions = 52 | Options 53 | { connectionSettings = defJSONSettings, 54 | batchSize = Nothing, 55 | language = Nothing, 56 | aliases = Nothing, 57 | scriptEvaluationTimeout = Nothing 58 | } 59 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Codec.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket.Codec 3 | -- Description: Encoder\/decoder of Request\/Response 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- 7 | module Network.Greskell.WebSocket.Codec 8 | ( -- * Codec 9 | Codec (..) 10 | -- * Request encoder 11 | , encodeBinaryWith 12 | , messageHeader 13 | -- * Request decoder 14 | , decodeBinary 15 | ) where 16 | 17 | import Control.Monad (when) 18 | import qualified Data.ByteString.Lazy as BSL 19 | import Data.Monoid ((<>)) 20 | import Data.Text (Text) 21 | import Data.Text.Encoding (decodeUtf8', encodeUtf8) 22 | 23 | import Network.Greskell.WebSocket.Request (RequestMessage) 24 | import Network.Greskell.WebSocket.Response (ResponseMessage) 25 | 26 | -- | Encoder of 'RequestMessage' and decoder of 'ResponseMessage', 27 | -- associated with a MIME type. 28 | -- 29 | -- Type @s@ is the body of Response. 30 | data Codec s 31 | = Codec 32 | { mimeType :: Text 33 | -- ^ MIME type sent to the server 34 | , encodeWith :: RequestMessage -> BSL.ByteString 35 | -- ^ Request encoder 36 | , decodeWith :: BSL.ByteString -> Either String (ResponseMessage s) 37 | -- ^ Response decoder 38 | } 39 | 40 | instance Functor Codec where 41 | fmap f c = c { decodeWith = (fmap . fmap . fmap) f $ decodeWith c } 42 | 43 | -- | Make a request message header. 44 | messageHeader :: Text -- ^ MIME type 45 | -> BSL.ByteString 46 | messageHeader mime = BSL.singleton size <> mime_bin 47 | where 48 | size = fromIntegral $ BSL.length mime_bin -- what if 'mime' is too long?? 49 | mime_bin = BSL.fromStrict $ encodeUtf8 mime 50 | 51 | -- | Encode a 'RequestMessage' into a \"binary\" format of Gremlin 52 | -- Server. The result includes the message \"header\" and the 53 | -- \"payload\". 54 | encodeBinaryWith :: Codec s -> RequestMessage -> BSL.ByteString 55 | encodeBinaryWith c req = messageHeader (mimeType c) <> encodeWith c req 56 | 57 | -- | Decode a message in the \"binary\" format. This is mainly for 58 | -- testing purposes. 59 | decodeBinary :: BSL.ByteString 60 | -> Either String (Text, BSL.ByteString) -- ^ (mimeType, payload) 61 | decodeBinary raw_msg = do 62 | case BSL.uncons raw_msg of 63 | Nothing -> Left "Length of MIME type is missing in the header." 64 | Just (mime_len, rest) -> decodeMimeAndPayload mime_len rest 65 | where 66 | decodeMimeAndPayload mime_lenw msg = do 67 | when (BSL.length mime_field /= mime_len) $ Left ("Too short MIME field: " <> show mime_field) 68 | mime_text <- either (Left . show) Right $ decodeUtf8' $ BSL.toStrict $ mime_field 69 | return (mime_text, payload) 70 | where 71 | (mime_field, payload) = BSL.splitAt mime_len msg 72 | mime_len = fromIntegral mime_lenw 73 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Codec/JSON.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | 3 | -- Module: Network.Greskell.WebSocket.Codec.JSON 4 | -- Description: application\/json codec 5 | -- Maintainer: Toshio Ito 6 | -- 7 | -- 8 | module Network.Greskell.WebSocket.Codec.JSON 9 | ( jsonCodec 10 | ) where 11 | 12 | import Data.Aeson (FromJSON, ToJSON) 13 | import qualified Data.Aeson as A 14 | import Data.Aeson.Types (parseEither) 15 | 16 | import Data.Greskell.GraphSON (FromGraphSON (..)) 17 | 18 | import Network.Greskell.WebSocket.Codec (Codec (..)) 19 | 20 | -- | Simple \"application\/json\" codec. 21 | -- 22 | -- The encoder uses GraphSON v1 format. The decoder supports all 23 | -- GraphSON v1, v2 and v3. 24 | jsonCodec :: (FromGraphSON s) => Codec s 25 | jsonCodec = Codec { mimeType = "application/json", 26 | encodeWith = encode, 27 | decodeWith = decode 28 | } 29 | where 30 | encode = A.encode 31 | decode bs = parseEither parseGraphSON =<< A.eitherDecode' bs 32 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Connection.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket.Connection 3 | -- Description: WebSocket Connection to Gremlin Server 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- 7 | module Network.Greskell.WebSocket.Connection 8 | ( -- * Make a Connection 9 | connect 10 | , close 11 | , Connection 12 | , Host 13 | , Port 14 | -- ** Settings for Connection 15 | , module Network.Greskell.WebSocket.Connection.Settings 16 | -- * Make a request 17 | , sendRequest 18 | , sendRequest' 19 | , ResponseHandle 20 | , nextResponse 21 | , nextResponseSTM 22 | , slurpResponses 23 | , drainResponses 24 | -- * Exceptions 25 | , GeneralException (..) 26 | , RequestException (..) 27 | ) where 28 | 29 | import Network.Greskell.WebSocket.Connection.Impl 30 | import Network.Greskell.WebSocket.Connection.Settings 31 | import Network.Greskell.WebSocket.Connection.Type 32 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Connection/Settings.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket.Connection.Settings 3 | -- Description: Settings for making Connection 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- 7 | module Network.Greskell.WebSocket.Connection.Settings 8 | ( -- * Settings 9 | Settings 10 | , defSettings 11 | , defJSONSettings 12 | -- ** accessor functions 13 | , codec 14 | , endpointPath 15 | , onGeneralException 16 | , responseTimeout 17 | , concurrency 18 | , requestQueueSize 19 | ) where 20 | 21 | import Data.Greskell.GraphSON (FromGraphSON) 22 | 23 | import Network.Greskell.WebSocket.Codec (Codec) 24 | import Network.Greskell.WebSocket.Codec.JSON (jsonCodec) 25 | import Network.Greskell.WebSocket.Connection.Type (GeneralException) 26 | 27 | import System.IO (hPutStrLn, stderr) 28 | 29 | -- | 'Settings' for making connection to Gremlin Server. 30 | -- 31 | -- You can get the default 'Settings' by 'defSettings' function, and 32 | -- customize its fields by accessor functions. 33 | -- 34 | -- Type @s@ is the body of Response. 35 | data Settings s 36 | = Settings 37 | { codec :: !(Codec s) 38 | -- ^ codec for the connection. 39 | , endpointPath :: !String 40 | -- ^ Path of the WebSocket endpoint. Default: \"/gremlin\" 41 | , onGeneralException :: !(GeneralException -> IO ()) 42 | -- ^ An exception handler for 'GeneralException'. This exception 43 | -- is not fatal, so the connection survives after this handler is 44 | -- called. You don't have to re-throw the exception. Default: 45 | -- print the exception to stderr. 46 | , responseTimeout :: !Int 47 | -- ^ Time out (in seconds) for responses. It is the maximum time 48 | -- for which the connection waits for a response to complete after 49 | -- it sends a request. If the response consists of more than one 50 | -- ResponseMessages, the timeout applies to the last of the 51 | -- ResponseMessages. Default: 60 52 | , concurrency :: !Int 53 | -- ^ Maximum concurrent requests the connection can make to the 54 | -- server. If the client tries to make more concurrent requests 55 | -- than this value, later requests are queued in the connection or 56 | -- the client may be blocked. Default: 4 57 | , requestQueueSize :: !Int 58 | -- ^ Size of the internal queue of requests. Usually you don't 59 | -- need to customize the field. See also 'concurrency'. Default: 60 | -- 8. 61 | } 62 | 63 | defSettings :: Codec s -> Settings s 64 | defSettings c = Settings 65 | { codec = c, 66 | endpointPath = "/gremlin", 67 | onGeneralException = \e -> hPutStrLn stderr $ show e, 68 | responseTimeout = 60, 69 | concurrency = 4, 70 | requestQueueSize = 8 71 | } 72 | 73 | -- | 'defSettings' with 'jsonCodec'. 74 | defJSONSettings :: FromGraphSON s => Settings s 75 | defJSONSettings = defSettings jsonCodec 76 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Connection/Type.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket.Connection.Type 3 | -- Description: common types for Connection 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- This is an internal module. This defines and exports common types 7 | -- used by Connection modules. The upper module is responsible to 8 | -- limit exports from this module. 9 | module Network.Greskell.WebSocket.Connection.Type 10 | ( RawReq 11 | , RawRes 12 | , ReqID 13 | , ResPack 14 | , ReqPack (..) 15 | , ConnectionState (..) 16 | , Connection (..) 17 | , GeneralException (..) 18 | ) where 19 | 20 | import Control.Concurrent.Async (Async) 21 | import Control.Concurrent.STM (TBQueue, TQueue, TVar) 22 | import Control.Exception.Safe (Exception, SomeException, Typeable) 23 | import qualified Data.ByteString.Lazy as BSL 24 | import Data.UUID (UUID) 25 | 26 | import Network.Greskell.WebSocket.Codec (Codec) 27 | import Network.Greskell.WebSocket.Response (ResponseMessage) 28 | 29 | type RawReq = BSL.ByteString 30 | type RawRes = BSL.ByteString 31 | type ReqID = UUID 32 | 33 | -- | Package of Response data and related stuff. 34 | type ResPack s = Either SomeException (ResponseMessage s) 35 | 36 | -- | Package of request data and related stuff. It's passed from the 37 | -- caller thread into WS handling thread. 38 | data ReqPack s 39 | = ReqPack 40 | { reqData :: !RawReq 41 | -- ^ Encoded request data 42 | , reqId :: !ReqID 43 | -- ^ request ID 44 | , reqOutput :: !(TQueue (ResPack s)) 45 | -- ^ the output queue for incoming response for this request. 46 | } 47 | 48 | -- | State of the 'Connection'. 49 | data ConnectionState 50 | = ConnOpen 51 | -- ^ Connection is open and ready to use. 52 | | ConnClosing 53 | -- ^ Connection is closing. It rejects new requests, but keeps 54 | -- receiving responses for pending requests. When there is no 55 | -- pending requests, it goes to 'ConnClosed'. 56 | | ConnClosed 57 | -- ^ Connection is closed. It rejects requests, and it doesn't 58 | -- expect any responses. It can close the underlying WebSocket 59 | -- connection. 60 | deriving (Bounded, Enum, Eq, Ord, Show) 61 | 62 | -- | A WebSocket connection to a Gremlin Server. 63 | -- 64 | -- Type @s@ is the body of Response, as in 'ResponseMessage'. 65 | data Connection s 66 | = Connection 67 | { connQReq :: !(TBQueue (ReqPack s)) 68 | -- ^ Request queue to WS (Mux) thread. 69 | , connState :: !(TVar ConnectionState) 70 | , connWSThread :: !(Async ()) 71 | -- ^ WS (Mux) thread. It keeps the underlying WebSocket 72 | -- connection, watches various types of events and responds to 73 | -- those events. 74 | , connCodec :: !(Codec s) 75 | } 76 | 77 | -- | Exception general to a 'Connection'. It's not related to specific 78 | -- requests. 79 | data GeneralException 80 | = UnexpectedRequestId UUID 81 | -- ^ Server sends a 'ResponseMessage' with unknown requestId, which 82 | -- is kept in this exception. 83 | | ResponseParseFailure String 84 | -- ^ The 'Connection' fails to parse a data from the server. The 85 | -- error message is kept in this exception. 86 | deriving (Eq, Show, Typeable) 87 | 88 | instance Exception GeneralException 89 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Request.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DuplicateRecordFields #-} 3 | -- | 4 | -- Module: Network.Greskell.WebSocket.Request 5 | -- Description: Request to Gremlin Server 6 | -- Maintainer: Toshio Ito 7 | -- 8 | -- 9 | module Network.Greskell.WebSocket.Request 10 | ( -- * RequestMessage 11 | RequestMessage (..) 12 | , Operation (..) 13 | , toRequestMessage 14 | , makeRequestMessage 15 | ) where 16 | 17 | import Control.Applicative ((<$>), (<*>)) 18 | import Data.Aeson (FromJSON (..), Object, ToJSON (..)) 19 | import Data.Text (Text) 20 | import Data.UUID (UUID) 21 | import Data.UUID.V4 (nextRandom) 22 | import GHC.Generics (Generic) 23 | 24 | import qualified Network.Greskell.WebSocket.Request.Aeson as GAeson 25 | import Network.Greskell.WebSocket.Request.Common (Operation (..)) 26 | 27 | 28 | -- | RequestMessage to a Gremlin Server. See 29 | -- . 30 | data RequestMessage 31 | = RequestMessage 32 | { requestId :: !UUID 33 | , op :: !Text 34 | , processor :: !Text 35 | , args :: !Object 36 | } 37 | deriving (Eq, Generic, Show) 38 | 39 | instance ToJSON RequestMessage where 40 | toJSON = GAeson.genericToJSON GAeson.opt 41 | toEncoding = GAeson.genericToEncoding GAeson.opt 42 | 43 | instance FromJSON RequestMessage where 44 | parseJSON = GAeson.genericParseJSON GAeson.opt 45 | 46 | -- | Convert an 'Operation' object to 'RequestMessage'. 47 | toRequestMessage :: Operation o => UUID -> o -> RequestMessage 48 | toRequestMessage rid o = 49 | RequestMessage { requestId = rid, 50 | op = opName o, 51 | processor = opProcessor o, 52 | args = opArgs o 53 | } 54 | 55 | -- | Create a 'RequestMessage' from an 'Operation' object. The 56 | -- 'requestId' is generated by the random number generator of the 57 | -- system. 58 | makeRequestMessage :: Operation o => o -> IO RequestMessage 59 | makeRequestMessage o = toRequestMessage <$> nextRandom <*> pure o 60 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Request/Aeson.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket.Request.Aeson 3 | -- Description: parser support 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- __Internal module. End-users should not use this.__ 7 | module Network.Greskell.WebSocket.Request.Aeson 8 | ( genericToJSON 9 | , genericToEncoding 10 | , genericParseJSON 11 | , opt 12 | , toObject 13 | ) where 14 | 15 | import Data.Aeson (Object, ToJSON (..), Value (Object), genericParseJSON, 16 | genericToEncoding, genericToJSON) 17 | import Data.Aeson.Types (Options, defaultOptions, omitNothingFields) 18 | 19 | opt :: Options 20 | opt = defaultOptions { omitNothingFields = True } 21 | 22 | toObject :: (ToJSON a) => a -> Object 23 | toObject = expectObject . toJSON 24 | where 25 | expectObject (Object o) = o 26 | expectObject _ = error "Expect Object, but got something else" 27 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Request/Common.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | 3 | -- Module: Network.Greskell.WebSocket.Request.Common 4 | -- Description: Common data types for Request objects 5 | -- Maintainer: Toshio Ito 6 | -- 7 | -- 8 | module Network.Greskell.WebSocket.Request.Common 9 | ( Operation (..) 10 | , SASLMechanism (..) 11 | , Base64 (..) 12 | ) where 13 | 14 | import Control.Applicative (empty) 15 | import Data.Aeson (FromJSON (..), Object, ToJSON (..), Value (String)) 16 | import Data.ByteString (ByteString) 17 | import qualified Data.ByteString.Base64 as B64 18 | import Data.Text (Text, unpack) 19 | import Data.Text.Encoding (decodeUtf8, encodeUtf8) 20 | 21 | 22 | -- | Class of operation objects. 23 | class Operation o where 24 | opProcessor :: o -> Text 25 | -- ^ \"processor\" field. 26 | opName :: o -> Text 27 | -- ^ \"op\" field. 28 | opArgs :: o -> Object 29 | -- ^ \"args\" field. 30 | 31 | instance (Operation a, Operation b) => Operation (Either a b) where 32 | opProcessor e = either opProcessor opProcessor e 33 | opName e = either opName opName e 34 | opArgs e = either opArgs opArgs e 35 | 36 | 37 | -- | Possible SASL mechanisms. 38 | data SASLMechanism 39 | = SASLPlain -- ^ \"PLAIN\" SASL 40 | | SASLGSSAPI -- ^ \"GSSAPI\" SASL 41 | deriving (Bounded, Enum, Eq, Ord, Show) 42 | 43 | instance ToJSON SASLMechanism where 44 | toJSON = toJSON . toText 45 | where 46 | toText :: SASLMechanism -> Text 47 | toText SASLPlain = "PLAIN" 48 | toText SASLGSSAPI = "GSSAPI" 49 | 50 | instance FromJSON SASLMechanism where 51 | parseJSON (String s) = case s of 52 | "PLAIN" -> return SASLPlain 53 | "GSSAPI" -> return SASLGSSAPI 54 | _ -> fail ("Unknown SASLMechanism: " ++ unpack s) 55 | parseJSON _ = empty 56 | 57 | -- | A raw 'ByteString' encoded to\/decoded from a base64 text. 58 | -- 59 | -- 'ToJSON' instance encodes the raw 'ByteString' to a base64-encoded 60 | -- 'Text'. 'FromJSON' is its inverse. 61 | newtype Base64 62 | = Base64 { unByte64 :: ByteString } 63 | deriving (Eq, Ord, Show) 64 | 65 | instance ToJSON Base64 where 66 | toJSON (Base64 bs) = toJSON $ decodeUtf8 $ B64.encode bs 67 | 68 | instance FromJSON Base64 where 69 | parseJSON (String t) = either fail (return . Base64) $ B64.decode $ encodeUtf8 t 70 | parseJSON _ = empty 71 | 72 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Request/Session.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DuplicateRecordFields #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | -- | 5 | -- Module: Network.Greskell.WebSocket.Request.Session 6 | -- Description: Operation objects for session OpProcessor 7 | -- Maintainer: Toshio Ito 8 | -- 9 | -- 10 | module Network.Greskell.WebSocket.Request.Session 11 | ( -- * OpAuthentication 12 | OpAuthentication (..) 13 | -- * OpEval 14 | , SessionID 15 | , OpEval (..) 16 | -- * OpClose 17 | , OpClose (..) 18 | ) where 19 | 20 | import Data.Aeson (FromJSON (..), Object, ToJSON (..)) 21 | import Data.HashMap.Strict (HashMap) 22 | import Data.Text (Text) 23 | import Data.UUID (UUID) 24 | import GHC.Generics (Generic) 25 | 26 | import qualified Network.Greskell.WebSocket.Request.Aeson as GAeson 27 | import Network.Greskell.WebSocket.Request.Common (Base64, Operation (..), SASLMechanism) 28 | 29 | data OpAuthentication 30 | = OpAuthentication 31 | { batchSize :: !(Maybe Int) 32 | , sasl :: !Base64 33 | , saslMechanism :: !SASLMechanism 34 | } 35 | deriving (Eq, Generic, Ord, Show) 36 | 37 | instance ToJSON OpAuthentication where 38 | toJSON = GAeson.genericToJSON GAeson.opt 39 | toEncoding = GAeson.genericToEncoding GAeson.opt 40 | 41 | instance FromJSON OpAuthentication where 42 | parseJSON = GAeson.genericParseJSON GAeson.opt 43 | 44 | instance Operation OpAuthentication where 45 | opProcessor _ = "session" 46 | opName _ = "authentication" 47 | opArgs = GAeson.toObject 48 | 49 | 50 | type SessionID = UUID 51 | 52 | data OpEval 53 | = OpEval 54 | { batchSize :: !(Maybe Int) 55 | , gremlin :: !Text 56 | , bindings :: !(Maybe Object) 57 | , language :: !(Maybe Text) 58 | , aliases :: !(Maybe (HashMap Text Text)) 59 | , scriptEvaluationTimeout :: !(Maybe Int) 60 | , session :: !SessionID 61 | , manageTransaction :: !(Maybe Bool) 62 | } 63 | deriving (Eq, Generic, Show) 64 | 65 | instance ToJSON OpEval where 66 | toJSON = GAeson.genericToJSON GAeson.opt 67 | toEncoding = GAeson.genericToEncoding GAeson.opt 68 | 69 | instance FromJSON OpEval where 70 | parseJSON = GAeson.genericParseJSON GAeson.opt 71 | 72 | instance Operation OpEval where 73 | opProcessor _ = "session" 74 | opName _ = "eval" 75 | opArgs = GAeson.toObject 76 | 77 | 78 | data OpClose 79 | = OpClose 80 | { batchSize :: !(Maybe Int) 81 | , session :: !SessionID 82 | , force :: !(Maybe Bool) 83 | } 84 | deriving (Eq, Generic, Ord, Show) 85 | 86 | instance ToJSON OpClose where 87 | toJSON = GAeson.genericToJSON GAeson.opt 88 | toEncoding = GAeson.genericToEncoding GAeson.opt 89 | 90 | instance FromJSON OpClose where 91 | parseJSON = GAeson.genericParseJSON GAeson.opt 92 | 93 | instance Operation OpClose where 94 | opProcessor _ = "session" 95 | opName _ = "close" 96 | opArgs = GAeson.toObject 97 | 98 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Request/Standard.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DuplicateRecordFields #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | -- | 5 | -- Module: Network.Greskell.WebSocket.Request.Standard 6 | -- Description: Operation objects for standard OpProcessor 7 | -- Maintainer: Toshio Ito 8 | -- 9 | -- 10 | module Network.Greskell.WebSocket.Request.Standard 11 | ( -- * OpAuthentication 12 | OpAuthentication (..) 13 | -- * OpEval 14 | , OpEval (..) 15 | ) where 16 | 17 | import Data.Aeson (FromJSON (..), Object, ToJSON (..)) 18 | import Data.HashMap.Strict (HashMap) 19 | import Data.Text (Text) 20 | import GHC.Generics (Generic) 21 | 22 | import qualified Network.Greskell.WebSocket.Request.Aeson as GAeson 23 | import Network.Greskell.WebSocket.Request.Common (Base64, Operation (..), SASLMechanism) 24 | 25 | data OpAuthentication 26 | = OpAuthentication 27 | { batchSize :: !(Maybe Int) 28 | , sasl :: !Base64 29 | , saslMechanism :: !SASLMechanism 30 | } 31 | deriving (Eq, Generic, Ord, Show) 32 | 33 | instance ToJSON OpAuthentication where 34 | toJSON = GAeson.genericToJSON GAeson.opt 35 | toEncoding = GAeson.genericToEncoding GAeson.opt 36 | 37 | instance FromJSON OpAuthentication where 38 | parseJSON = GAeson.genericParseJSON GAeson.opt 39 | 40 | instance Operation OpAuthentication where 41 | opProcessor _ = "" 42 | opName _ = "authentication" 43 | opArgs = GAeson.toObject 44 | 45 | data OpEval 46 | = OpEval 47 | { batchSize :: !(Maybe Int) 48 | , gremlin :: !Text 49 | , bindings :: !(Maybe Object) 50 | , language :: !(Maybe Text) 51 | , aliases :: !(Maybe (HashMap Text Text)) 52 | , scriptEvaluationTimeout :: !(Maybe Int) 53 | } 54 | deriving (Eq, Generic, Show) 55 | 56 | instance ToJSON OpEval where 57 | toJSON = GAeson.genericToJSON GAeson.opt 58 | toEncoding = GAeson.genericToEncoding GAeson.opt 59 | 60 | instance FromJSON OpEval where 61 | parseJSON = GAeson.genericParseJSON GAeson.opt 62 | 63 | instance Operation OpEval where 64 | opProcessor _ = "" 65 | opName _ = "eval" 66 | opArgs = GAeson.toObject 67 | 68 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Response.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | -- | 4 | -- Module: Network.Greskell.WebSocket.Response 5 | -- Description: Response from Gremlin Server 6 | -- Maintainer: Toshio Ito 7 | -- 8 | -- 9 | module Network.Greskell.WebSocket.Response 10 | ( -- * ResponseMessage 11 | ResponseMessage (..) 12 | -- * ResponseStatus 13 | , ResponseStatus (..) 14 | -- * ResponseResult 15 | , ResponseResult (..) 16 | -- * ResponseCode 17 | , ResponseCode (..) 18 | , codeToInt 19 | , codeFromInt 20 | , isTerminating 21 | , isSuccess 22 | , isClientSideError 23 | , isServerSideError 24 | ) where 25 | 26 | import Control.Applicative ((<$>), (<*>)) 27 | import Data.Aeson (FromJSON (..), Object, ToJSON (..), 28 | Value (Number, Object), defaultOptions, 29 | genericParseJSON) 30 | import Data.Greskell.GraphSON (FromGraphSON (..), GValueBody (..), gsonValue, 31 | parseUnwrapAll, (.:)) 32 | import Data.Greskell.GraphSON.GValue (gValueBody) 33 | import Data.Text (Text) 34 | import Data.UUID (UUID) 35 | import GHC.Generics (Generic) 36 | 37 | 38 | 39 | -- | Response status code 40 | data ResponseCode = Success | NoContent | PartialContent | Unauthorized | Authenticate | MalformedRequest | InvalidRequestArguments | ServerError | ScriptEvaluationError | ServerTimeout | ServerSerializationError deriving 41 | ( Bounded 42 | , Enum 43 | , Eq 44 | , Ord 45 | , Show 46 | ) 47 | 48 | codeToInt :: ResponseCode -> Int 49 | codeToInt c = case c of 50 | Success -> 200 51 | NoContent -> 204 52 | PartialContent -> 206 53 | Unauthorized -> 401 54 | Authenticate -> 407 55 | MalformedRequest -> 498 56 | InvalidRequestArguments -> 499 57 | ServerError -> 500 58 | ScriptEvaluationError -> 597 59 | ServerTimeout -> 598 60 | ServerSerializationError -> 599 61 | 62 | codeFromInt :: Int -> Maybe ResponseCode 63 | codeFromInt i = case i of 64 | 200 -> Just Success 65 | 204 -> Just NoContent 66 | 206 -> Just PartialContent 67 | 401 -> Just Unauthorized 68 | 407 -> Just Authenticate 69 | 498 -> Just MalformedRequest 70 | 499 -> Just InvalidRequestArguments 71 | 500 -> Just ServerError 72 | 597 -> Just ScriptEvaluationError 73 | 598 -> Just ServerTimeout 74 | 599 -> Just ServerSerializationError 75 | _ -> Nothing 76 | 77 | -- | Returns 'True' if the 'ResponseCode' is a terminating code. 78 | isTerminating :: ResponseCode -> Bool 79 | isTerminating PartialContent = False 80 | isTerminating _ = True 81 | 82 | isCodeClass :: Int -> ResponseCode -> Bool 83 | isCodeClass n c = (codeToInt c `div` 100) == n 84 | 85 | -- | Returns 'True' if the 'ResponseCode' is a success. 86 | isSuccess :: ResponseCode -> Bool 87 | isSuccess = isCodeClass 2 88 | 89 | -- | Returns 'True' if the 'ResponseCode' is a client-side failure. 90 | isClientSideError :: ResponseCode -> Bool 91 | isClientSideError = isCodeClass 4 92 | 93 | -- | Returns 'True' if the 'ResponseCode' is a server-side failure. 94 | isServerSideError :: ResponseCode -> Bool 95 | isServerSideError = isCodeClass 5 96 | 97 | instance FromJSON ResponseCode where 98 | parseJSON (Number n) = maybe err return $ codeFromInt $ floor n 99 | where 100 | err = fail ("Unknown response code: " ++ show n) 101 | parseJSON v = fail ("Expected Number, but got " ++ show v) 102 | 103 | instance FromGraphSON ResponseCode where 104 | parseGraphSON = parseUnwrapAll 105 | 106 | instance ToJSON ResponseCode where 107 | toJSON = toJSON . codeToInt 108 | 109 | -- | \"status\" field. 110 | data ResponseStatus 111 | = ResponseStatus 112 | { code :: !ResponseCode 113 | , message :: !Text 114 | , attributes :: !Object 115 | } 116 | deriving (Eq, Generic, Show) 117 | 118 | instance FromJSON ResponseStatus where 119 | parseJSON v = parseGraphSON =<< parseJSON v 120 | 121 | instance FromGraphSON ResponseStatus where 122 | parseGraphSON gv = case gValueBody gv of 123 | GObject o -> 124 | ResponseStatus 125 | <$> o .: "code" 126 | <*> o .: "message" 127 | <*> o .: "attributes" 128 | gb -> fail ("Expected GObject, but got " ++ show gb) 129 | 130 | 131 | -- | \"result\" field. 132 | data ResponseResult s 133 | = ResponseResult 134 | { resultData :: !s 135 | -- ^ \"data\" field. 136 | , meta :: !Object 137 | } 138 | deriving (Eq, Generic, Show) 139 | 140 | instance FromGraphSON s => FromJSON (ResponseResult s) where 141 | parseJSON v = parseGraphSON =<< parseJSON v 142 | 143 | instance FromGraphSON s => FromGraphSON (ResponseResult s) where 144 | parseGraphSON gv = case gValueBody gv of 145 | GObject o -> 146 | ResponseResult 147 | <$> o .: "data" 148 | <*> o .: "meta" 149 | gb -> fail ("Expected GObject, but got " ++ show gb) 150 | 151 | instance Functor ResponseResult where 152 | fmap f rr = rr { resultData = f $ resultData rr } 153 | 154 | -- | ResponseMessage object from Gremlin Server. See 155 | -- . 156 | -- 157 | -- Type @s@ is the type of the response data. 158 | data ResponseMessage s 159 | = ResponseMessage 160 | { requestId :: !UUID 161 | , status :: !ResponseStatus 162 | , result :: !(ResponseResult s) 163 | } 164 | deriving (Eq, Generic, Show) 165 | 166 | instance FromGraphSON s => FromJSON (ResponseMessage s) where 167 | parseJSON v = parseGraphSON =<< parseJSON v 168 | 169 | instance FromGraphSON s => FromGraphSON (ResponseMessage s) where 170 | parseGraphSON gv = case gValueBody gv of 171 | GObject o -> 172 | ResponseMessage 173 | <$> (o .: "requestId") 174 | <*> (o .: "status") 175 | <*> (o .: "result") 176 | gb -> fail ("Expected GObject, but got " ++ show gb) 177 | 178 | instance Functor ResponseMessage where 179 | fmap f rm = rm { result = fmap f $ result rm } 180 | -------------------------------------------------------------------------------- /greskell-websocket/src/Network/Greskell/WebSocket/Util.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Network.Greskell.WebSocket.Util 3 | -- Description: Common utility 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- __Internal module__. 7 | module Network.Greskell.WebSocket.Util 8 | ( slurp 9 | , drain 10 | ) where 11 | 12 | import Data.Monoid ((<>)) 13 | import qualified Data.Vector as V 14 | 15 | slurp :: Monad m => m (Maybe a) -> m (V.Vector a) 16 | slurp act = go mempty 17 | where 18 | go got = do 19 | mres <- act 20 | case mres of 21 | Nothing -> return got 22 | Just res -> go $! (V.snoc got res) 23 | 24 | drain :: Monad m => m (Maybe a) -> m () 25 | drain act = go 26 | where 27 | go = do 28 | mres <- act 29 | case mres of 30 | Nothing -> return () 31 | Just _ -> go 32 | -------------------------------------------------------------------------------- /greskell-websocket/test/Network/Greskell/WebSocket/ResponseSpec.hs: -------------------------------------------------------------------------------- 1 | module Network.Greskell.WebSocket.ResponseSpec 2 | ( main 3 | , spec 4 | ) where 5 | 6 | import Control.Monad (mapM_) 7 | import Test.Hspec 8 | 9 | import Network.Greskell.WebSocket.Response (ResponseCode (..), isClientSideError, 10 | isServerSideError, isSuccess) 11 | 12 | main :: IO () 13 | main = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | describe "isSuccess" $ do 18 | mapM_ (uncurry $ makeResponseCodeSpec isSuccess) $ [(Success, True), (Unauthorized, False), (ServerError, False)] 19 | describe "isClientSideError" $ do 20 | mapM_ (uncurry $ makeResponseCodeSpec isClientSideError) $ [(Success, False), (Unauthorized, True), (ServerError, False)] 21 | describe "isServerSideError" $ do 22 | mapM_ (uncurry $ makeResponseCodeSpec isServerSideError) $ [(Success, False), (Unauthorized, False), (ServerError, True)] 23 | 24 | makeResponseCodeSpec :: (ResponseCode -> Bool) -> ResponseCode -> Bool -> Spec 25 | makeResponseCodeSpec testee input want = specify (show input) $ testee input `shouldBe` want 26 | -------------------------------------------------------------------------------- /greskell-websocket/test/ServerTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DuplicateRecordFields #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Main 4 | ( main 5 | , spec 6 | ) where 7 | import Test.Hspec 8 | 9 | import qualified ServerTest.Client as Client 10 | import qualified ServerTest.Connection as Conn 11 | 12 | main :: IO () 13 | main = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | Conn.spec 18 | Client.spec 19 | -------------------------------------------------------------------------------- /greskell-websocket/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /greskell-websocket/test/TestUtil/Env.hs: -------------------------------------------------------------------------------- 1 | module TestUtil.Env 2 | ( requireEnv 3 | , withEnvForExtServer 4 | , withEnvForIntServer 5 | ) where 6 | 7 | import System.Environment (lookupEnv) 8 | import Test.Hspec 9 | 10 | import Network.Greskell.WebSocket.Connection (Host, Port) 11 | 12 | requireEnv :: String -> IO String 13 | requireEnv env_key = maybe bail return =<< lookupEnv env_key 14 | where 15 | bail = expectationFailure msg >> return "" 16 | where 17 | msg = "Set environment variable "++ env_key ++ " for Server test. " 18 | 19 | withEnvForExtServer :: SpecWith (Host, Port) -> Spec 20 | withEnvForExtServer = before $ do 21 | hostname <- requireEnv "GRESKELL_TEST_HOST" 22 | port <- fmap read $ requireEnv "GRESKELL_TEST_PORT" 23 | return (hostname, port) 24 | 25 | withEnvForIntServer :: SpecWith Port -> Spec 26 | withEnvForIntServer = before $ fmap read $ requireEnv "GRESKELL_TEST_INTERNAL_PORT" 27 | 28 | -------------------------------------------------------------------------------- /greskell-websocket/test/TestUtil/MockServer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module TestUtil.MockServer 3 | ( wsServer 4 | , parseRequest 5 | , receiveRequest 6 | , simpleRawResponse 7 | , waitForServer 8 | ) where 9 | 10 | import Control.Concurrent (threadDelay) 11 | import Control.Exception.Safe (throwString) 12 | import qualified Data.Aeson as Aeson 13 | import qualified Data.ByteString.Lazy as BSL 14 | import Data.Monoid ((<>)) 15 | import Data.Text (Text, pack) 16 | import Data.UUID (UUID) 17 | import qualified Data.UUID as UUID 18 | import qualified Network.WebSockets as WS 19 | 20 | import Network.Greskell.WebSocket.Codec (decodeBinary) 21 | import Network.Greskell.WebSocket.Request (RequestMessage) 22 | 23 | 24 | wsServer :: Int -- ^ port number 25 | -> (WS.Connection -> IO ()) 26 | -> IO () 27 | wsServer p act = WS.runServer "localhost" p $ \pending_conn -> 28 | act =<< WS.acceptRequest pending_conn 29 | 30 | parseRequest :: BSL.ByteString -> Either String RequestMessage 31 | parseRequest raw_msg = do 32 | (_, payload) <- decodeBinary raw_msg 33 | Aeson.eitherDecode payload 34 | 35 | receiveRequest :: WS.Connection -> IO RequestMessage 36 | receiveRequest wsconn = do 37 | raw_msg <- WS.receiveData wsconn 38 | case parseRequest raw_msg of 39 | Left e -> throwString e 40 | Right r -> return r 41 | 42 | simpleRawResponse :: UUID -> Int -> Text -> Text 43 | simpleRawResponse request_id status_code data_content = 44 | "{\"requestId\":\"" <> UUID.toText request_id <> "\"," 45 | <> "\"status\":{\"code\":" <> (pack $ show status_code) <> ",\"message\":\"\",\"attributes\":{}}," 46 | <> "\"result\":{\"data\":" <> data_content <> ",\"meta\":{}}}" 47 | 48 | waitForServer :: IO () 49 | waitForServer = threadDelay 100000 50 | -------------------------------------------------------------------------------- /greskell-websocket/test/TestUtil/TCounter.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: TestUtil.TCounter 3 | -- Description: 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- 7 | module TestUtil.TCounter 8 | ( TCounter 9 | , new 10 | , modify 11 | , now 12 | , waitFor 13 | , history 14 | , count 15 | ) where 16 | 17 | import Control.Applicative ((<$>), (<*>)) 18 | import Control.Concurrent.STM (STM, TVar, atomically, modifyTVar, newTVarIO, readTVar, 19 | retry) 20 | 21 | -- | Transaction counter. 22 | data TCounter 23 | = TCounter 24 | { tcCurrent :: TVar Int 25 | , tcHistory :: TVar [Int] 26 | } 27 | 28 | new :: IO TCounter 29 | new = TCounter <$> newTVarIO 0 <*> newTVarIO [] 30 | 31 | modify :: TCounter -> (Int -> Int) -> IO () 32 | modify tc f = atomically $ do 33 | modifyTVar (tcCurrent tc) f 34 | conc <- readTVar (tcCurrent tc) 35 | modifyTVar (tcHistory tc) (conc :) 36 | 37 | now :: TCounter -> IO Int 38 | now tc = atomically $ nowSTM tc 39 | 40 | nowSTM :: TCounter -> STM Int 41 | nowSTM tc = readTVar $ tcCurrent tc 42 | 43 | waitFor :: TCounter -> (Int -> Bool) -> IO () 44 | waitFor tc p = atomically $ do 45 | cur <- nowSTM tc 46 | if p cur 47 | then return () 48 | else retry 49 | 50 | history :: TCounter -> IO [Int] 51 | history tc = reverse <$> (atomically $ readTVar $ tcHistory tc) 52 | 53 | count :: TCounter -> IO a -> (a -> IO b) -> IO b 54 | count tc start_act finish_act = do 55 | tx <- start_act 56 | modify tc (+ 1) 57 | ret <- finish_act tx 58 | modify tc (subtract 1) 59 | return ret 60 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/request_auth_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "cb682578-9d92-4499-9ebc-5c6aa73c5397", 3 | "op" : "authentication", 4 | "processor" : "", 5 | "args" : { 6 | "saslMechanism" : "PLAIN", 7 | "sasl" : "AHN0ZXBocGhlbgBwYXNzd29yZA==" 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/request_session_close_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "cb682578-9d92-4499-9ebc-5c6aa73c5397", 3 | "op" : "close", 4 | "processor" : "session", 5 | "args" : { 6 | "session" : "41d2e28a-20a4-4ab0-b379-d810dede3786" 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/request_session_eval_aliased_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "cb682578-9d92-4499-9ebc-5c6aa73c5397", 3 | "op" : "eval", 4 | "processor" : "session", 5 | "args" : { 6 | "gremlin" : "social.V(x)", 7 | "language" : "gremlin-groovy", 8 | "aliases" : { 9 | "g" : "social" 10 | }, 11 | "session" : "41d2e28a-20a4-4ab0-b379-d810dede3786", 12 | "bindings" : { 13 | "x" : 1 14 | } 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/request_session_eval_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "cb682578-9d92-4499-9ebc-5c6aa73c5397", 3 | "op" : "eval", 4 | "processor" : "session", 5 | "args" : { 6 | "gremlin" : "g.V(x)", 7 | "language" : "gremlin-groovy", 8 | "session" : "41d2e28a-20a4-4ab0-b379-d810dede3786", 9 | "bindings" : { 10 | "x" : 1 11 | } 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/request_sessionless_eval_aliased_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "cb682578-9d92-4499-9ebc-5c6aa73c5397", 3 | "op" : "eval", 4 | "processor" : "", 5 | "args" : { 6 | "gremlin" : "social.V(x)", 7 | "language" : "gremlin-groovy", 8 | "aliases" : { 9 | "g" : "social" 10 | }, 11 | "bindings" : { 12 | "x" : 1 13 | } 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/request_sessionless_eval_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "cb682578-9d92-4499-9ebc-5c6aa73c5397", 3 | "op" : "eval", 4 | "processor" : "", 5 | "args" : { 6 | "gremlin" : "g.V(x)", 7 | "language" : "gremlin-groovy", 8 | "bindings" : { 9 | "x" : 1 10 | } 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/response_auth_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "41d2e28a-20a4-4ab0-b379-d810dede3786", 3 | "status" : { 4 | "message" : "", 5 | "code" : 407, 6 | "attributes" : { } 7 | }, 8 | "result" : { 9 | "data" : null, 10 | "meta" : { } 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/response_auth_v2.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "41d2e28a-20a4-4ab0-b379-d810dede3786", 3 | "status" : { 4 | "message" : "", 5 | "code" : 407, 6 | "attributes" : { } 7 | }, 8 | "result" : { 9 | "data" : null, 10 | "meta" : { } 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/response_auth_v3.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "41d2e28a-20a4-4ab0-b379-d810dede3786", 3 | "status" : { 4 | "message" : "", 5 | "code" : 407, 6 | "attributes" : { 7 | "@type" : "g:Map", 8 | "@value" : [ ] 9 | } 10 | }, 11 | "result" : { 12 | "data" : null, 13 | "meta" : { 14 | "@type" : "g:Map", 15 | "@value" : [ ] 16 | } 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/response_standard_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "41d2e28a-20a4-4ab0-b379-d810dede3786", 3 | "status" : { 4 | "message" : "", 5 | "code" : 200, 6 | "attributes" : { } 7 | }, 8 | "result" : { 9 | "data" : [ { 10 | "id" : 1, 11 | "label" : "person", 12 | "type" : "vertex" 13 | } ], 14 | "meta" : { } 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/response_standard_v2.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "41d2e28a-20a4-4ab0-b379-d810dede3786", 3 | "status" : { 4 | "message" : "", 5 | "code" : 200, 6 | "attributes" : { } 7 | }, 8 | "result" : { 9 | "data" : [ { 10 | "@type" : "g:Vertex", 11 | "@value" : { 12 | "id" : { 13 | "@type" : "g:Int32", 14 | "@value" : 1 15 | }, 16 | "label" : "person" 17 | } 18 | } ], 19 | "meta" : { } 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /greskell-websocket/test/samples/response_standard_v3.json: -------------------------------------------------------------------------------- 1 | { 2 | "requestId" : "41d2e28a-20a4-4ab0-b379-d810dede3786", 3 | "status" : { 4 | "message" : "", 5 | "code" : 200, 6 | "attributes" : { 7 | "@type" : "g:Map", 8 | "@value" : [ ] 9 | } 10 | }, 11 | "result" : { 12 | "data" : { 13 | "@type" : "g:List", 14 | "@value" : [ { 15 | "@type" : "g:Vertex", 16 | "@value" : { 17 | "id" : { 18 | "@type" : "g:Int32", 19 | "@value" : 1 20 | }, 21 | "label" : "person" 22 | } 23 | } ] 24 | }, 25 | "meta" : { 26 | "@type" : "g:Map", 27 | "@value" : [ ] 28 | } 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /greskell/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Toshio Ito 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Toshio Ito nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /greskell/README.md: -------------------------------------------------------------------------------- 1 | # greskell 2 | 3 | Haskell binding for Gremlin query language. 4 | 5 | See the package description, or [project README](https://github.com/debug-ito/greskell/blob/master/README.md). 6 | 7 | ## Author 8 | 9 | Toshio Ito 10 | -------------------------------------------------------------------------------- /greskell/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /greskell/src/Data/Greskell.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Data.Greskell 3 | -- Description: Haskell binding for Gremlin graph query language 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- Data.Greskell is a Haskell support to use the Gremlin graph query 7 | -- language. For more information, see [project README](https://github.com/debug-ito/greskell). 8 | -- 9 | -- This module re-exports most modules from greskell and greskell-core 10 | -- packages. The following modules are excluded from re-export: 11 | -- 12 | -- - "Data.Greskell.Extra": extra utility functions. 13 | -- - "Data.Greskell.NonEmptyLike": NonEmptyLike class, which is a 14 | -- class of non-empty containers. 15 | -- - "Data.Greskell.Logic": Logic type, which is a general-purpose logic tree data structure. 16 | -- - "Data.Greskell.Graph.PropertyMap": deprecated PropertyMap class. 17 | -- - "Data.Greskell.GTraversal.Gen": an experimental module that has generalized versions of Gremlin traversals defined in "Data.Greskell.GTraversal". 18 | module Data.Greskell 19 | ( module Data.Greskell.Greskell 20 | , module Data.Greskell.Binder 21 | , module Data.Greskell.GTraversal 22 | , module Data.Greskell.Gremlin 23 | , module Data.Greskell.Graph 24 | , module Data.Greskell.GraphSON 25 | , module Data.Greskell.GMap 26 | , module Data.Greskell.AsIterator 27 | , module Data.Greskell.AsLabel 28 | , module Data.Greskell.PMap 29 | ) where 30 | 31 | import Data.Greskell.AsIterator 32 | import Data.Greskell.AsLabel 33 | import Data.Greskell.Binder 34 | import Data.Greskell.GMap hiding (examples) 35 | import Data.Greskell.Graph hiding (examples) 36 | import Data.Greskell.GraphSON hiding (examples) 37 | import Data.Greskell.Gremlin hiding (examples) 38 | import Data.Greskell.Greskell hiding (examples) 39 | import Data.Greskell.GTraversal hiding (examples) 40 | import Data.Greskell.PMap 41 | -------------------------------------------------------------------------------- /greskell/src/Data/Greskell/AsLabel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | -- | 4 | -- Module: Data.Greskell.AsLabel 5 | -- Description: Label string used in .as step 6 | -- Maintainer: Toshio Ito 7 | -- 8 | -- @since 0.2.2.0 9 | module Data.Greskell.AsLabel 10 | ( -- * AsLabel 11 | AsLabel (..) 12 | , SelectedMap 13 | , unsafeCastAsLabel 14 | -- * Re-exports 15 | , lookup 16 | , lookupM 17 | , lookupAs 18 | , lookupAsM 19 | , PMapLookupException (..) 20 | -- * LabeledP 21 | , LabeledP 22 | ) where 23 | 24 | import Prelude hiding (lookup) 25 | 26 | import Control.Exception (Exception) 27 | import Control.Monad.Catch (MonadThrow (..)) 28 | import Data.Foldable (Foldable) 29 | import Data.Greskell.GraphSON (FromGraphSON (..), GValue, GraphSONTyped (..), parseEither) 30 | import Data.Greskell.Greskell (ToGreskell (..)) 31 | import qualified Data.Greskell.Greskell as Greskell 32 | import Data.Hashable (Hashable) 33 | import Data.HashMap.Strict (HashMap) 34 | import qualified Data.HashMap.Strict as HM 35 | import Data.String (IsString (..)) 36 | import Data.Text (Text) 37 | import Data.Traversable (Traversable) 38 | 39 | import Data.Greskell.Gremlin (P, PLike (..)) 40 | import Data.Greskell.PMap (PMap, PMapKey (..), PMapLookupException (..), Single, 41 | lookup, lookupAs, lookupAsM, lookupM) 42 | 43 | -- | 'AsLabel' @a@ represents a label string used in @.as@ step 44 | -- pointing to the data of type @a@. 45 | newtype AsLabel a 46 | = AsLabel { unAsLabel :: Text } 47 | deriving (Eq, Hashable, Ord, Show) 48 | 49 | -- | @since 1.0.0.0 50 | instance IsString (AsLabel a) where 51 | fromString = AsLabel . fromString 52 | 53 | -- | Returns the 'Text' as a Gremlin string. 54 | instance ToGreskell (AsLabel a) where 55 | type GreskellReturn (AsLabel a) = Text 56 | toGreskell (AsLabel t) = Greskell.string t 57 | 58 | -- | Unsafely convert the phantom type. 59 | instance Functor AsLabel where 60 | fmap _ (AsLabel t) = AsLabel t 61 | 62 | -- | @since 1.0.0.0 63 | instance PMapKey (AsLabel a) where 64 | type PMapValue (AsLabel a) = a 65 | keyText = unAsLabel 66 | 67 | -- | A map keyed with 'AsLabel'. Obtained from @.select@ step, for 68 | -- example. 69 | type SelectedMap = PMap Single 70 | 71 | -- | Unsafely cast the phantom type of the 'AsLabel'. 72 | -- 73 | -- @since 1.1.0.0 74 | unsafeCastAsLabel :: AsLabel a -> AsLabel b 75 | unsafeCastAsLabel = AsLabel . unAsLabel 76 | 77 | 78 | -- | 'LabeledP' is just like 'P', a Haskell representation of 79 | -- TinkerPop's @P@ class. Unlike 'P', however, 'LabeledP' keeps a 80 | -- label ('AsLabel') inside. It is used in @.where@ step. 81 | -- 82 | -- @since 1.2.0.0 83 | data LabeledP a 84 | 85 | -- Design note: neo4j-gremlin has `LabelP` class, which has nothing to 86 | -- do with the 'LabeledP' type above. 87 | 88 | 89 | -- | You can construct @Greskell (LabeledP a)@ from @AsLabel a@. 90 | instance PLike (LabeledP a) where 91 | type PParameter (LabeledP a) = AsLabel a 92 | -------------------------------------------------------------------------------- /greskell/src/Data/Greskell/Binder.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | -- | 4 | -- Module: Data.Greskell.Binder 5 | -- Description: Binder monad to make binding between Gremlin variables and JSON values 6 | -- Maintainer: Toshio Ito 7 | -- 8 | -- 9 | module Data.Greskell.Binder 10 | ( -- * Types 11 | Binder 12 | , Binding 13 | -- * Actions 14 | , newBind 15 | , newAsLabel 16 | -- * Runners 17 | , runBinder 18 | ) where 19 | 20 | import Control.Monad.Trans.State (State) 21 | import qualified Control.Monad.Trans.State as State 22 | import Data.Aeson (Object, ToJSON (toJSON), Value) 23 | import qualified Data.Aeson.Key as Key 24 | import qualified Data.Aeson.KeyMap as KM 25 | import Data.Monoid ((<>)) 26 | import qualified Data.Text as T 27 | import qualified Data.Text.Lazy as TL 28 | 29 | import Data.Greskell.AsLabel (AsLabel (..)) 30 | import Data.Greskell.Greskell (Greskell, unsafeGreskellLazy) 31 | 32 | -- | State in the 'Binder'. 33 | data BinderS 34 | = BinderS 35 | { varIndex :: PlaceHolderIndex 36 | , varBindings :: [Value] 37 | , asLabelIndex :: PlaceHolderIndex 38 | } 39 | deriving (Eq, Show) 40 | 41 | initBinderS :: BinderS 42 | initBinderS = 43 | BinderS 44 | { varIndex = 0, 45 | varBindings = [], 46 | asLabelIndex = 0 47 | } 48 | 49 | -- | A Monad that manages binding variables and labels to values. 50 | newtype Binder a 51 | = Binder { unBinder :: State BinderS a } 52 | deriving (Applicative, Functor, Monad) 53 | 54 | -- | Binding between Gremlin variable names and JSON values. 55 | type Binding = Object 56 | 57 | -- | Create a new Gremlin variable bound to the given value. 58 | -- 59 | -- The value @v@ is kept in the monadic context. The returned 60 | -- 'Greskell' is a Gremlin variable pointing to the @v@. The Gremlin 61 | -- variable is guaranteed to be unique in the current monadic context. 62 | newBind :: ToJSON v 63 | => v -- ^ bound value 64 | -> Binder (Greskell v) -- ^ variable 65 | newBind val = Binder $ do 66 | state <- State.get 67 | let next_index = varIndex state 68 | values = varBindings state 69 | State.put $ state { varIndex = succ next_index, 70 | varBindings = values ++ [toJSON val] 71 | } 72 | return $ unsafePlaceHolder next_index 73 | 74 | -- | Execute the given 'Binder' monad to obtain 'Binding'. 75 | runBinder :: Binder a -> (a, Binding) 76 | runBinder binder = (ret, binding) 77 | where 78 | (ret, state) = State.runState (unBinder binder) initBinderS 79 | values = varBindings state 80 | binding = KM.fromList $ zip (map toPlaceHolderVariableKey [0 ..]) $ values 81 | toPlaceHolderVariableKey = Key.fromText . TL.toStrict . toPlaceHolderVariable 82 | 83 | -- | __This type is only for internal use.__ 84 | type PlaceHolderIndex = Int 85 | 86 | -- | __This function is only for internal use.__ 87 | -- 88 | -- Unsafely create a placeholder variable of arbitrary type with the 89 | -- given index. 90 | unsafePlaceHolder :: PlaceHolderIndex -> Greskell a 91 | unsafePlaceHolder = unsafeGreskellLazy . wrapWithParens . toPlaceHolderVariable 92 | where 93 | wrapWithParens v = "((" <> v <> "))" 94 | -- This is necessary to ensure the v is always treated as a varible name (NOT a type name) in Groovy script. 95 | -- See https://github.com/debug-ito/greskell/issues/18 96 | 97 | -- | __This function is only for internal use.__ 98 | -- 99 | -- Create placeholder variable string from the index. 100 | toPlaceHolderVariable :: PlaceHolderIndex -> TL.Text 101 | toPlaceHolderVariable i = TL.pack ("__v" ++ show i) 102 | 103 | -- | Create a new 'AsLabel'. 104 | -- 105 | -- The returned 'AsLabel' is guaranteed to be unique in the current 106 | -- monadic context. 107 | -- 108 | -- @since 0.2.2.0 109 | newAsLabel :: Binder (AsLabel a) 110 | newAsLabel = Binder $ do 111 | state <- State.get 112 | let label_index = asLabelIndex state 113 | label = "__a" ++ show label_index 114 | State.put $ state { asLabelIndex = succ label_index } 115 | return $ AsLabel $ T.pack label 116 | -------------------------------------------------------------------------------- /greskell/src/Data/Greskell/Logic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | -- | 3 | -- Module: Data.Greskell.Logic 4 | -- Description: Logic tree data structure 5 | -- Maintainer: Toshio Ito 6 | -- 7 | -- Developer note: This module defines 'Logic', a data structure for 8 | -- logic operation tree. There are already similar packages to this 9 | -- module, but, none of them satisfy our requirements. 10 | -- 11 | -- Boolean/logic tree data structures 12 | -- 13 | -- - https://hackage.haskell.org/package/boolean-normal-forms 14 | -- - https://hackage.haskell.org/package/logic-classes 15 | -- - https://hackage.haskell.org/package/PropLogic 16 | -- - https://hackage.haskell.org/package/Logic 17 | -- - https://hackage.haskell.org/package/boolean-like 18 | -- 19 | -- Typeclasses about boolean/logic operations 20 | -- 21 | -- - https://hackage.haskell.org/package/Boolean 22 | -- - https://hackage.haskell.org/package/cond 23 | -- 24 | -- Trees that contain heterogeneous values 25 | -- 26 | -- - http://hackage.haskell.org/package/dual-tree 27 | -- - http://hackage.haskell.org/package/fingertree 28 | -- 29 | -- @since 1.2.0.0 30 | module Data.Greskell.Logic 31 | ( Logic (..) 32 | , runBool 33 | ) where 34 | 35 | import Control.Applicative (Applicative (pure, (<*>)), (<$>)) 36 | import Control.Monad (Monad (return, (>>=))) 37 | import Data.Foldable (Foldable (foldMap, toList)) 38 | import Data.Monoid (All (..), Any (..), (<>)) 39 | import Data.Traversable (Traversable) 40 | import GHC.Generics (Generic) 41 | 42 | -- | A general-purpose logic tree structure. Only the leaf nodes have 43 | -- values of type @a@. The tree is lazy both in value and spine (structure). 44 | data Logic a 45 | = Leaf a -- ^ Leaf node with value 46 | | And (Logic a) [Logic a] -- ^ \"and\" logic operator 47 | | Or (Logic a) [Logic a] -- ^ \"or\" logic operator 48 | | Not (Logic a) -- ^ \"not\" logic operator 49 | deriving (Eq, Generic, Ord, Show) 50 | 51 | instance Functor Logic where 52 | fmap f l = 53 | case l of 54 | Leaf a -> Leaf (f a) 55 | And ll rls -> And (fmap f ll) (map (fmap f) rls) 56 | Or ll rls -> Or (fmap f ll) (map (fmap f) rls) 57 | Not nl -> Not (fmap f nl) 58 | 59 | -- | 'pure' is 'Leaf'. @fl@ '<*>' @rl@ appends the @rl@ to the leaves 60 | -- of @fl@. 61 | instance Applicative Logic where 62 | pure a = Leaf a 63 | fl <*> rl = 64 | case fl of 65 | Leaf f -> fmap f rl 66 | And lfl rfls -> And (lfl <*> rl) (map (<*> rl) rfls) 67 | Or lfl rfls -> Or (lfl <*> rl) (map (<*> rl) rfls) 68 | Not nfl -> Not (nfl <*> rl) 69 | 70 | instance Monad Logic where 71 | return = pure 72 | l >>= f = 73 | case l of 74 | Leaf a -> f a 75 | And ll rls -> And (ll >>= f) (map (>>= f) rls) 76 | Or ll rls -> Or (ll >>= f) (map (>>= f) rls) 77 | Not nl -> Not (nl >>= f) 78 | 79 | instance Foldable Logic where 80 | foldMap f l = 81 | case l of 82 | Leaf a -> f a 83 | And ll rls -> foldMap f ll <> foldMap (foldMap f) rls 84 | Or ll rls -> foldMap f ll <> foldMap (foldMap f) rls 85 | Not nl -> foldMap f nl 86 | 87 | instance Traversable Logic where 88 | traverse f l = 89 | case l of 90 | Leaf a -> Leaf <$> f a 91 | And ll rls -> And <$> traverse f ll <*> traverse (traverse f) rls 92 | Or ll rls -> Or <$> traverse f ll <*> traverse (traverse f) rls 93 | Not nl -> Not <$> traverse f nl 94 | 95 | -- | Run the logic tree of 'Bool' values to get the result. 96 | runBool :: Logic Bool -> Bool 97 | runBool l = 98 | case l of 99 | Leaf b -> b 100 | And ll rls -> getAll $ mconcat $ (All $ runBool ll) : map (All . runBool) rls 101 | Or ll rls -> getAny $ mconcat $ (Any $ runBool ll) : map (Any . runBool) rls 102 | Not nl -> not $ runBool nl 103 | -------------------------------------------------------------------------------- /greskell/src/Data/Greskell/NonEmptyLike.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Data.Greskell.NonEmptyLike 3 | -- Description: Class of non-empty containers 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- @since 1.0.0.0 7 | module Data.Greskell.NonEmptyLike 8 | ( NonEmptyLike (..) 9 | ) where 10 | 11 | import qualified Data.Foldable as F 12 | import Data.List.NonEmpty (NonEmpty (..)) 13 | import Data.Semigroup (Semigroup, (<>)) 14 | import qualified Data.Semigroup as S 15 | 16 | -- | Non-empty containers. Its cardinality is one or more. 17 | -- 18 | -- @since 1.0.0.0 19 | class F.Foldable t => NonEmptyLike t where 20 | -- | Make a container with a single value. 21 | singleton :: a -> t a 22 | -- | Append two containers. 23 | append :: t a -> t a -> t a 24 | -- | Convert the container to 'NonEmpty' list. 25 | toNonEmpty :: t a -> NonEmpty a 26 | 27 | -- | 'append' is '<>' from 'Semigroup'. 28 | instance NonEmptyLike NonEmpty where 29 | singleton a = a :| [] 30 | append = (<>) 31 | toNonEmpty = id 32 | 33 | -- | 'append' is '<>' from 'Semigroup'. 34 | instance NonEmptyLike S.First where 35 | singleton = S.First 36 | append = (<>) 37 | toNonEmpty (S.First a) = singleton a 38 | 39 | -- | 'append' is '<>' from 'Semigroup'. 40 | instance NonEmptyLike S.Last where 41 | singleton = S.Last 42 | append = (<>) 43 | toNonEmpty (S.Last a) = singleton a 44 | 45 | -------------------------------------------------------------------------------- /greskell/test/Data/Greskell/BinderSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Data.Greskell.BinderSpec 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import Control.Applicative ((<$>), (<*>)) 8 | import Control.Monad (forM_) 9 | import Data.Aeson (toJSON) 10 | import qualified Data.Aeson.Key as Key 11 | import qualified Data.Aeson.KeyMap as KM 12 | import Data.Text (Text) 13 | import qualified Data.Text as T 14 | import Test.Hspec 15 | 16 | import Data.Greskell.AsLabel (AsLabel) 17 | import Data.Greskell.Binder (Binder, newAsLabel, newBind, runBinder) 18 | import Data.Greskell.Greskell (Greskell, toGremlin, unsafeGreskell) 19 | 20 | main :: IO () 21 | main = hspec spec 22 | 23 | extractVarName :: Greskell a -> IO Text 24 | extractVarName got_greskell = checkVarName =<< (stripParens $ toGremlin got_greskell) 25 | where 26 | stripParens v = 27 | case T.stripPrefix "((" =<< T.stripSuffix "))" v of 28 | Nothing -> do 29 | expectationFailure "Binder should produce an expression of a variable wrapped with double parens" 30 | return "" 31 | Just a -> return a 32 | checkVarName v = 33 | case T.unpack v of 34 | [] -> do 35 | expectationFailure "Expect a Gremlin variable, but got empty script." 36 | return "" 37 | (h : rest) -> do 38 | h `shouldSatisfy` (`elem` variableHeads) 39 | forM_ rest (`shouldSatisfy` (`elem` variableRests)) 40 | return v 41 | variableHeads = '_' : (['a' .. 'z'] ++ ['A' .. 'Z']) 42 | variableRests = variableHeads ++ ['0' .. '9'] 43 | 44 | spec :: Spec 45 | spec = describe "Binder" $ do 46 | it "should keep bound values" $ do 47 | let b = do 48 | v1 <- newBind (100 :: Int) 49 | v2 <- newBind ("hogehoge" :: Text) 50 | return (v1, v2) 51 | ((got_v1, got_v2), got_bind) = runBinder b 52 | toGremlin got_v1 `shouldNotBe` toGremlin got_v2 53 | v1Name <- extractVarName got_v1 54 | v2Name <- extractVarName got_v2 55 | got_bind `shouldBe` KM.fromList [ (Key.fromText v1Name, toJSON (100 :: Int)), 56 | (Key.fromText v2Name, toJSON ("hogehoge" :: Text)) 57 | ] 58 | it "should compose and produce new variables" $ do 59 | let b = newBind ("foobar" :: Text) 60 | ((got_v1, got_v2), got_bind) = runBinder $ ((,) <$> b <*> b) 61 | toGremlin got_v1 `shouldNotBe` toGremlin got_v2 62 | v1Name <- extractVarName got_v1 63 | v2Name <- extractVarName got_v2 64 | got_bind `shouldBe` KM.fromList [ (Key.fromText v1Name, toJSON ("foobar" :: Text)), 65 | (Key.fromText v2Name, toJSON ("foobar" :: Text)) 66 | ] 67 | it "should also be able to produce AsLabels" $ do 68 | let newIntLabel :: Binder (AsLabel Int) 69 | newIntLabel = newAsLabel 70 | newVar = newBind ("foobar" :: Text) 71 | ((got_v1, got_l1, got_v2, got_l2), _) = 72 | runBinder $ ((,,,) <$> newVar <*> newIntLabel <*> newVar <*> newIntLabel) 73 | _ <- extractVarName got_v1 74 | _ <- extractVarName got_v2 75 | toGremlin got_v1 `shouldNotBe` toGremlin got_v2 76 | got_l1 `shouldNotBe` got_l2 77 | -------------------------------------------------------------------------------- /greskell/test/Data/Greskell/ExtraSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Data.Greskell.ExtraSpec 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import qualified Data.Aeson.KeyMap as KM 8 | import Data.Monoid (mempty, (<>)) 9 | import Data.Text (Text) 10 | import Test.Hspec 11 | 12 | import Data.Aeson (Value (..)) 13 | import Data.Greskell.Binder (Binder, Binding, runBinder) 14 | import Data.Greskell.Extra (writeKeyValues, writePropertyKeyValues) 15 | import Data.Greskell.Graph (AVertex, Key, KeyValue, (=:)) 16 | import Data.Greskell.Greskell (toGremlin) 17 | import Data.Greskell.GTraversal (Walk, WalkType) 18 | 19 | main :: IO () 20 | main = hspec spec 21 | 22 | runBoundWalk :: WalkType c => Binder (Walk c AVertex AVertex) -> (Text, Binding) 23 | runBoundWalk = doFst . runBinder 24 | where 25 | doFst (w, b) = (toGremlin w, b) 26 | 27 | spec :: Spec 28 | spec = do 29 | describe "writePropertyKeyValues" $ do 30 | specify "empty" $ do 31 | let input :: [(Text, ())] 32 | input = [] 33 | (runBoundWalk $ writePropertyKeyValues input) `shouldBe` ("__.identity()", mempty) 34 | specify "one prop" $ do 35 | let input :: [(Text, Int)] 36 | input = [("age", 24)] 37 | (runBoundWalk $ writePropertyKeyValues input) 38 | `shouldBe` ( "__.property(\"age\",((__v0))).identity()", 39 | KM.fromList [("__v0", Number 24)] 40 | ) 41 | specify "multiple props" $ do 42 | let input :: [(Text, Value)] 43 | input = [("age", Number 24), ("name", String "Toshio"), ("foo", String "bar")] 44 | (runBoundWalk $ writePropertyKeyValues input) 45 | `shouldBe` ( "__.property(\"age\",((__v0))).property(\"name\",((__v1)))" 46 | <> ".property(\"foo\",((__v2))).identity()", 47 | KM.fromList [ ("__v0", Number 24), 48 | ("__v1", String "Toshio"), 49 | ("__v2", String "bar") 50 | ] 51 | ) 52 | describe "writeKeyValues" $ do 53 | specify "empty" $ do 54 | (toGremlin $ writeKeyValues ([] :: [KeyValue AVertex])) `shouldBe` "__.identity()" 55 | specify "key-values" $ do 56 | let name :: Key AVertex Text 57 | name = "name" 58 | age :: Key AVertex Int 59 | age = "age" 60 | input = writeKeyValues [name =: "toshio", age =: 30] 61 | (toGremlin input) `shouldBe` "__.property(\"name\",\"toshio\").property(\"age\",30).identity()" 62 | -------------------------------------------------------------------------------- /greskell/test/Data/Greskell/Graph/PropertyMapSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Data.Greskell.Graph.PropertyMapSpec 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import Data.Monoid (mempty, (<>)) 8 | import Test.Hspec 9 | 10 | import Data.Greskell.Graph.PropertyMap (AProperty (..), PropertyMap (..), PropertyMapList, 11 | PropertyMapSingle) 12 | 13 | main :: IO () 14 | main = hspec spec 15 | 16 | spec :: Spec 17 | spec = do 18 | describe "PropertyMapSingle" $ do 19 | let pm :: PropertyMapSingle AProperty Int 20 | pm = putProperty (AProperty "buzz" 300) 21 | $ putProperty (AProperty "bar" 200) 22 | $ putProperty (AProperty "foo" 100) mempty 23 | specify "allProperties" $ do 24 | allProperties pm `shouldMatchList` 25 | [ AProperty "buzz" 300, 26 | AProperty "bar" 200, 27 | AProperty "foo" 100 28 | ] 29 | specify "lookupOne existing" $ do 30 | lookupOne "foo" pm `shouldBe` (Just $ AProperty "foo" 100) 31 | specify "lookupOne non-existing" $ do 32 | lookupOne "HOGE" pm `shouldBe` Nothing 33 | specify "lookupList existing" $ do 34 | lookupList "bar" pm `shouldBe` [AProperty "bar" 200] 35 | specify "lookupList non-existing" $ do 36 | lookupList "HOGE" pm `shouldBe` [] 37 | specify "putProperty overrides" $ do 38 | let pm2 = putProperty (AProperty "foo" 500) pm 39 | lookupOne "foo" pm2 `shouldBe` Just (AProperty "foo" 500) 40 | lookupList "foo" pm2 `shouldBe` [AProperty "foo" 500] 41 | specify "removeProperty" $ do 42 | let pm2 = removeProperty "HOGE" $ removeProperty "bar" pm 43 | lookupList "bar" pm2 `shouldBe` [] 44 | specify "mappend prefers the left" $ do 45 | let pm2 :: PropertyMapSingle AProperty Int 46 | pm2 = putProperty (AProperty "hoge" 600) 47 | $ putProperty (AProperty "bar" 500) mempty 48 | pm3 = pm <> pm2 49 | allProperties pm3 `shouldMatchList` 50 | [ AProperty "buzz" 300, 51 | AProperty "bar" 200, 52 | AProperty "foo" 100, 53 | AProperty "hoge" 600 54 | ] 55 | describe "PropertyMapList" $ do 56 | let pm :: PropertyMapList AProperty Int 57 | pm = putProperty (AProperty "foo" 100) 58 | $ putProperty (AProperty "foo" 200) 59 | $ putProperty (AProperty "bar" 300) 60 | $ putProperty (AProperty "foo" 400) mempty 61 | specify "allProperties" $ do 62 | allProperties pm `shouldMatchList` 63 | [ AProperty "foo" 100, 64 | AProperty "foo" 200, 65 | AProperty "bar" 300, 66 | AProperty "foo" 400 67 | ] 68 | specify "lookupOne existing" $ do 69 | lookupOne "foo" pm `shouldBe` Just (AProperty "foo" 100) 70 | specify "lookupOne non-existing" $ do 71 | lookupOne "HOGE" pm `shouldBe` Nothing 72 | specify "lookupList existing" $ do 73 | lookupList "foo" pm `shouldBe` map (AProperty "foo") [100,200,400] 74 | specify "lookupList non-existing" $ do 75 | lookupList "HOGE" pm `shouldBe` [] 76 | specify "putProperty appends" $ do 77 | let pm2 = putProperty (AProperty "bar" 500) pm 78 | lookupOne "bar" pm2 `shouldBe` Just (AProperty "bar" 500) 79 | lookupList "bar" pm2 `shouldBe` map (AProperty "bar") [500,300] 80 | specify "removeProperty" $ do 81 | let pm2 = removeProperty "foo" $ removeProperty "HOGE" pm 82 | lookupOne "foo" pm2 `shouldBe` Nothing 83 | lookupList "foo" pm2 `shouldBe` [] 84 | specify "mappend appends" $ do 85 | let pm2 :: PropertyMapList AProperty Int 86 | pm2 = putProperty (AProperty "bar" 500) 87 | $ putProperty (AProperty "buzz" 600) 88 | $ putProperty (AProperty "foo" 700) mempty 89 | pm3 = pm <> pm2 90 | lookupList "foo" pm3 `shouldBe` map (AProperty "foo") [100,200,400,700] 91 | lookupList "bar" pm3 `shouldBe` map (AProperty "bar") [300,500] 92 | allProperties pm3 `shouldMatchList` 93 | [ AProperty "foo" 100, 94 | AProperty "foo" 200, 95 | AProperty "foo" 400, 96 | AProperty "foo" 700, 97 | AProperty "bar" 300, 98 | AProperty "bar" 500, 99 | AProperty "buzz" 600 100 | ] 101 | 102 | -------------------------------------------------------------------------------- /greskell/test/Data/Greskell/GremlinSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Data.Greskell.GremlinSpec 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import Test.Hspec 8 | 9 | import Control.Monad (forM_) 10 | import Data.Greskell.Gremlin (P, pAnd, pBetween, pGte, pNegate, pOr, pTest, pWithin) 11 | import Data.Greskell.Greskell (Greskell, toGremlin) 12 | import Data.Text (unpack) 13 | 14 | main :: IO () 15 | main = hspec spec 16 | 17 | spec :: Spec 18 | spec = do 19 | describe "P and Predicate" $ do 20 | specify "P and Predicate methods" $ do 21 | let pr :: Greskell (P Int) 22 | pr = pBetween 10 50 `pAnd` ((pNegate (pWithin [5, 15, 25, 35])) `pOr` pGte 20) 23 | expr = pr `pTest` 50 24 | toGremlin expr `shouldBe` 25 | "((P.between(10,50)).and(((P.within(5,15,25,35)).negate()).or(P.gte(20)))).test(50)" 26 | -------------------------------------------------------------------------------- /greskell/test/Data/Greskell/LogicSpec.hs: -------------------------------------------------------------------------------- 1 | module Data.Greskell.LogicSpec 2 | ( main 3 | , spec 4 | ) where 5 | 6 | import Control.Applicative ((<$>), (<*>)) 7 | import Control.Monad (forM_) 8 | import Data.Foldable (toList) 9 | import Data.Monoid ((<>)) 10 | import Data.Traversable (traverse) 11 | import Test.Hspec 12 | 13 | import Data.Greskell.Logic (Logic (..), runBool) 14 | 15 | main :: IO () 16 | main = hspec spec 17 | 18 | spec :: Spec 19 | spec = do 20 | let tree_int :: Logic Int 21 | tree_int = 22 | ( And 23 | ( Or (Leaf 10) [Leaf 20, Not (Leaf 30)]) 24 | [ Leaf 40, 25 | Not 26 | ( Or (Leaf 50) [And (Or (Leaf 60) []) [], Not (Leaf 70)] 27 | ) 28 | ] 29 | ) 30 | describe "Functor" $ do 31 | specify "fmap on tree" $ do 32 | fmap (\n -> 30 <= n && n <= 60) tree_int 33 | `shouldBe` 34 | ( And 35 | ( Or (Leaf False) [Leaf False, Not (Leaf True)]) 36 | [ Leaf True, 37 | Not 38 | ( Or (Leaf True) [And (Or (Leaf True) []) [], Not (Leaf False)] 39 | ) 40 | ] 41 | ) 42 | describe "Applicative" $ do 43 | specify "<*> should append the right tree to the left tree" $ do 44 | let tree_right :: Logic Int 45 | tree_right = And (Leaf 5) [Leaf 3, Or (Leaf 2) [Leaf 4]] 46 | plusRight n = fmap (+ n) tree_right 47 | ((+) <$> tree_int <*> tree_right) 48 | `shouldBe` 49 | ( And 50 | ( Or (plusRight 10) [plusRight 20, Not (plusRight 30)]) 51 | [ plusRight 40, 52 | Not 53 | ( Or (plusRight 50) [And (Or (plusRight 60) []) [], Not (plusRight 70)] 54 | ) 55 | ] 56 | ) 57 | describe "Foldable" $ do 58 | specify "toList should preserve the look of the structure" $ do 59 | toList tree_int 60 | `shouldBe` 61 | [10, 20, 30, 40, 50, 60, 70] 62 | describe "Traversable" $ do 63 | specify "traverse should preserve the structure" $ do 64 | traverse Just tree_int 65 | `shouldBe` 66 | Just tree_int 67 | specify "traverse should run the action of the applicative" $ do 68 | traverse (\n -> if n == 20 then Nothing else Just n) tree_int `shouldBe` Nothing 69 | describe "runBool" $ do 70 | specify "Leaf" $ do 71 | runBool (Leaf True) `shouldBe` True 72 | runBool (Leaf False) `shouldBe` False 73 | specify "Not" $ do 74 | runBool (Not $ Leaf True) `shouldBe` False 75 | runBool (Not $ Leaf False) `shouldBe` True 76 | describe "And" $ do 77 | forM_ [True, False] $ \b1 -> do 78 | specify ("single " <> show b1) $ do 79 | runBool (And (Leaf b1) []) `shouldBe` b1 80 | forM_ [True, False] $ \b2 -> do 81 | specify ("double " <> show (b1, b2)) $ do 82 | runBool (And (Leaf b1) [Leaf b2]) `shouldBe` b1 && b2 83 | describe "Or" $ do 84 | forM_ [True, False] $ \b1 -> do 85 | specify ("single " <> show b1) $ do 86 | runBool (Or (Leaf b1) []) `shouldBe` b1 87 | forM_ [True, False] $ \b2 -> do 88 | specify ("double " <> show (b1, b2)) $ do 89 | runBool (Or (Leaf b1) [Leaf b2]) `shouldBe` b1 || b2 90 | -------------------------------------------------------------------------------- /greskell/test/Data/Greskell/PMapSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Data.Greskell.PMapSpec 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import Prelude hiding (lookup) 8 | 9 | import Data.Text (Text) 10 | import Test.Hspec 11 | 12 | import Data.Greskell.PMap (Multi, PMap, Single, lookup, lookupList, pMapDelete, 13 | pMapFromList, pMapInsert, pMapToList) 14 | 15 | main :: IO () 16 | main = hspec spec 17 | 18 | -- the tests are based on PropertyMapSpec. 19 | 20 | spec :: Spec 21 | spec = do 22 | describe "PMap Single" $ do 23 | let pm :: PMap Single Int 24 | pm = pMapFromList 25 | [ ("buzz", 300), 26 | ("bar", 200), 27 | ("foo", 100) 28 | ] 29 | specify "pMapToList" $ do 30 | pMapToList pm `shouldMatchList` 31 | [ ("buzz", 300), 32 | ("bar", 200), 33 | ("foo", 100) 34 | ] 35 | specify "lookup existing" $ do 36 | lookup ("foo" :: Text) pm `shouldBe` Just 100 37 | specify "lookup non-existing" $ do 38 | lookup ("HOGE" :: Text) pm `shouldBe` Nothing 39 | specify "lookupList existing" $ do 40 | lookupList ("foo" :: Text) pm `shouldBe` [100] 41 | specify "lookupList non-existing" $ do 42 | lookupList ("HOGE" :: Text) pm `shouldBe` [] 43 | specify "pMapInsert overrides" $ do 44 | let pm2 = pMapInsert "foo" 500 pm 45 | pMapToList pm2 `shouldMatchList` 46 | [ ("buzz", 300), 47 | ("bar", 200), 48 | ("foo", 500) 49 | ] 50 | specify "pMapFromList prefers the first value" $ do 51 | let pm2 :: PMap Single Int 52 | pm2 = pMapFromList 53 | [("foo", 100), ("foo", 200), ("foo", 300), ("bar", 400)] 54 | pMapToList pm2 `shouldMatchList` [("foo", 100), ("bar", 400)] 55 | specify "pMapDelete" $ do 56 | let pm2 = pMapDelete "HOGE" $ pMapDelete "bar" $ pm 57 | pMapToList pm2 `shouldMatchList` 58 | [ ("buzz", 300), 59 | ("foo", 100) 60 | ] 61 | specify "<> prefers the left" $ do 62 | let pm2 = pMapFromList [("hoge", 600), ("bar", 500)] 63 | pm3 = pm <> pm2 64 | pMapToList pm3 `shouldMatchList` 65 | [ ("buzz", 300), 66 | ("bar", 200), 67 | ("foo", 100), 68 | ("hoge", 600) 69 | ] 70 | describe "PMap Multi" $ do 71 | let pm :: PMap Multi Int 72 | pm = pMapFromList 73 | [ ("foo", 100), 74 | ("foo", 200), 75 | ("bar", 300), 76 | ("foo", 400) 77 | ] 78 | specify "pMapToList" $ do 79 | pMapToList pm `shouldMatchList` 80 | [ ("foo", 100), 81 | ("foo", 200), 82 | ("bar", 300), 83 | ("foo", 400) 84 | ] 85 | specify "lookup existing" $ do 86 | lookup ("foo" :: Text) pm `shouldBe` Just 100 87 | specify "lookup non-existing" $ do 88 | lookup ("HOGE" :: Text) pm `shouldBe` Nothing 89 | specify "lookupList existing" $ do 90 | lookupList ("foo" :: Text) pm `shouldBe` [100,200,400] 91 | specify "lookupList non-existing" $ do 92 | lookupList ("HOGE" :: Text) pm `shouldBe` [] 93 | specify "pMapInsert prepends" $ do 94 | let pm2 = pMapInsert "bar" 500 pm 95 | pMapToList pm2 `shouldMatchList` 96 | [ ("bar", 500), 97 | ("foo", 100), 98 | ("foo", 200), 99 | ("bar", 300), 100 | ("foo", 400) 101 | ] 102 | lookup ("bar" :: Text) pm2 `shouldBe` Just 500 103 | lookupList ("bar" :: Text) pm2 `shouldBe` [500, 300] 104 | specify "pMapDelete" $ do 105 | let pm2 = pMapDelete "HOGE" $ pMapDelete "foo" pm 106 | pMapToList pm2 `shouldMatchList` [("bar", 300)] 107 | let pm3 = pMapDelete "bar" pm2 108 | pMapToList pm3 `shouldMatchList` [] 109 | specify "<> appends" $ do 110 | let pm2 = pMapFromList 111 | [ ("bar", 500), 112 | ("buzz", 600), 113 | ("foo", 700) 114 | ] 115 | pm3 = pm <> pm2 116 | lookupList ("foo" :: Text) pm3 `shouldBe` [100, 200, 400, 700] 117 | lookupList ("bar" :: Text) pm3 `shouldBe` [300, 500] 118 | pMapToList pm3 `shouldMatchList` 119 | [ ("foo", 100), 120 | ("foo", 200), 121 | ("bar", 300), 122 | ("foo", 400), 123 | ("bar", 500), 124 | ("buzz", 600), 125 | ("foo", 700) 126 | ] 127 | 128 | -------------------------------------------------------------------------------- /greskell/test/ExamplesSpec.hs: -------------------------------------------------------------------------------- 1 | module ExamplesSpec 2 | ( main 3 | , spec 4 | ) where 5 | 6 | import qualified Data.Greskell.Extra as Extra 7 | import qualified Data.Greskell.Graph as Graph 8 | import qualified Data.Greskell.Gremlin as Gremlin 9 | import qualified Data.Greskell.GTraversal as GTraversal 10 | 11 | import Control.Monad (forM_) 12 | import Test.Hspec 13 | 14 | main :: IO () 15 | main = hspec spec 16 | 17 | spec :: Spec 18 | spec = describe "examples" $ do 19 | makeSpec "Graph" Graph.examples 20 | makeSpec "Gremlin" Gremlin.examples 21 | makeSpec "GTraversal" GTraversal.examples 22 | makeSpec "Extra" Extra.examples 23 | 24 | makeSpec :: (Show a) => String -> [(a, a)] -> Spec 25 | makeSpec label exs = describe label $ forM_ exs $ \(got, expected) -> specify (show expected) $ show got `shouldBe` show expected 26 | -------------------------------------------------------------------------------- /greskell/test/ServerBehaviorTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import qualified Data.Vector as V 8 | import qualified Network.Greskell.WebSocket.Client as WS 9 | import System.IO (hPutStrLn, stderr) 10 | import Test.Hspec 11 | 12 | import Control.Category ((<<<)) 13 | import Control.Monad (void) 14 | import Data.Greskell.Binder (newBind, runBinder) 15 | import Data.Greskell.Graph (AEdge, AVertex (..), AVertexProperty (..), Key, 16 | Property (propertyKey, propertyValue)) 17 | import Data.Greskell.GraphSON (parseEither) 18 | import Data.Greskell.GTraversal (GTraversal, SideEffect, Walk, gAddE', gHas2, 19 | gHasId, gHasLabel, gId, gProperties, gProperty, 20 | gTo, gV', gValues, liftWalk, sAddV', sE', sV', 21 | source, ($.)) 22 | import Data.Text (Text) 23 | 24 | import ServerTest.Common (withClient, withEnv) 25 | 26 | main :: IO () 27 | main = hspec spec 28 | 29 | spec :: Spec 30 | spec = withEnv $ do 31 | spec_values_type 32 | spec_generic_element_ID 33 | spec_vertex_with_props 34 | 35 | clearGraph :: WS.Client -> IO () 36 | clearGraph client = WS.drainResults =<< WS.submitRaw client "g.V().drop()" Nothing 37 | 38 | spec_values_type :: SpecWith (String,Int) 39 | spec_values_type = describe "return type of .values step" $ do 40 | specify "input Int, get Int" $ withClient $ \client -> do 41 | let prop_key :: Key AVertex Int 42 | prop_key = "foobar" 43 | searchProp = WS.drainResults =<< WS.submit client script (Just binding) 44 | where 45 | (script, binding) = runBinder $ do 46 | input <- newBind (100 :: Int) 47 | return $ gHas2 prop_key input $. sV' [] $ source "g" 48 | putProp = WS.slurpResults =<< WS.submit client script (Just binding) 49 | where 50 | (script, binding) = runBinder $ do 51 | input <- newBind (100 :: Int) 52 | return $ liftWalk gId $. gProperty prop_key input $. sAddV' "hoge" $ source "g" 53 | getProp vid = WS.slurpResults =<< WS.submit client script (Just binding) 54 | where 55 | (script, binding) = runBinder $ do 56 | vid_var <- newBind vid 57 | return $ gValues [prop_key] $. gHasId vid_var $. gHasLabel "hoge" $. sV' [] $ source "g" 58 | clearGraph client 59 | searchProp 60 | got_ids <- putProp 61 | got <- getProp (got_ids V.! 0) 62 | V.toList got `shouldBe` [100] 63 | 64 | spec_generic_element_ID :: SpecWith (String, Int) 65 | spec_generic_element_ID = do 66 | specify "get Vertex ID as GValue, query Vertex by GValue" $ withClient $ \client -> do 67 | let prop_key :: Key AVertex Int 68 | prop_key = "sample" 69 | prop_val = 125 70 | make_v = liftWalk gId $. gProperty prop_key prop_val $. (sAddV' "test" $ source "g") 71 | clearGraph client 72 | got_ids <- fmap V.toList $ WS.slurpResults =<< WS.submit client make_v Nothing 73 | hPutStrLn stderr ("Got Vertex IDs: " <> show got_ids) 74 | length got_ids `shouldBe` 1 75 | let (q, qbind) = runBinder $ do 76 | vid <- newBind (got_ids !! 0) 77 | return $ gValues [prop_key] $. (sV' [vid] $ source "g") 78 | got_vals <- fmap V.toList $ WS.slurpResults =<< WS.submit client q (Just qbind) 79 | got_vals `shouldBe` [125] 80 | specify "get Edge ID as GValue, query Edge by GValue" $ withClient $ \client -> do 81 | let vname_key :: Key AVertex Text 82 | vname_key = "name" 83 | ename_key :: Key AEdge Text 84 | ename_key = "name" 85 | makeV n = (liftWalk $ gProperty vname_key n) $. (sAddV' "test_v" $ source "g") 86 | makeE fn tn = liftWalk gId 87 | $. gProperty ename_key "e_test" 88 | $. gAddE' "test_e" (gTo $ gHas2 vname_key tn <<< gV' []) 89 | $. gHas2 vname_key fn 90 | $. (liftWalk $ sV' [] $ source "g") 91 | clearGraph client 92 | void $ WS.slurpResults =<< WS.submit client (makeV "v_from") Nothing 93 | void $ WS.slurpResults =<< WS.submit client (makeV "v_to") Nothing 94 | got_ids <- fmap V.toList $ WS.slurpResults =<< WS.submit client (makeE "v_from" "v_to") Nothing 95 | hPutStrLn stderr ("Got Edge IDs: " <> show got_ids) 96 | length got_ids `shouldBe` 1 97 | let (q, qbind) = runBinder $ do 98 | eid <- newBind (got_ids !! 0) 99 | return $ gValues [ename_key] $. (sE' [eid] $ source "g") 100 | got_vals <- fmap V.toList $ WS.slurpResults =<< WS.submit client q (Just qbind) 101 | got_vals `shouldBe` ["e_test"] 102 | 103 | spec_vertex_with_props :: SpecWith (String, Int) 104 | spec_vertex_with_props = do 105 | let prop_key :: Key AVertex Int 106 | prop_key = "sample" 107 | makeV = gProperty prop_key 1132 $. (sAddV' "test" $ source "g") 108 | getProps vid = gProperties [prop_key] $. (sV' [vid] $ source "g") 109 | specify "get Vertex element as AVertex, VertexProperty element as AVertexProperty" $ withClient $ \client -> do 110 | clearGraph client 111 | got_vs <- fmap V.toList $ WS.slurpResults =<< WS.submit client makeV Nothing 112 | (fmap avLabel $ got_vs) `shouldBe` ["test"] 113 | let (query, bindings) = runBinder $ do 114 | vid <- newBind $ avId (got_vs !! 0) 115 | return $ getProps vid 116 | got_vps <- fmap V.toList $ WS.slurpResults =<< WS.submit client query (Just bindings) 117 | map (\vp -> (avpLabel vp, avpValue vp)) got_vps `shouldBe` [("sample", 1132)] 118 | -------------------------------------------------------------------------------- /greskell/test/ServerTest/Common.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: ServerTest.Common 3 | -- Description: 4 | -- Maintainer: Toshio Ito 5 | -- 6 | -- 7 | module ServerTest.Common 8 | ( withEnv 9 | , withClient 10 | ) where 11 | 12 | import Control.Exception.Safe (bracket) 13 | import qualified Network.Greskell.WebSocket.Client as WS 14 | import System.Environment (lookupEnv) 15 | import Test.Hspec 16 | 17 | requireEnv :: String -> IO String 18 | requireEnv env_key = maybe bail return =<< lookupEnv env_key 19 | where 20 | bail = expectationFailure msg >> return "" 21 | where 22 | msg = "Set environment variable "++ env_key ++ " for Server test. " 23 | 24 | withEnv :: SpecWith (String, Int) -> Spec 25 | withEnv = before $ do 26 | hostname <- requireEnv "GRESKELL_TEST_HOST" 27 | port <- fmap read $ requireEnv "GRESKELL_TEST_PORT" 28 | return (hostname, port) 29 | 30 | withClient :: (WS.Client -> IO ()) -> (String, Int) -> IO () 31 | withClient act (host, port) = bracket (WS.connect host port) WS.close act 32 | 33 | 34 | -------------------------------------------------------------------------------- /greskell/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /greskell/test/Typecheck.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-} 2 | module Main 3 | ( main 4 | , spec 5 | ) where 6 | 7 | import Data.Proxy (Proxy (..)) 8 | import Test.Hspec 9 | import Test.ShouldNotTypecheck (shouldNotTypecheck) 10 | 11 | import Data.Greskell.GTraversal (Filter, SideEffect, Split, Transform, Walk, WalkType, 12 | showLift, showSplit, showWalkType) 13 | 14 | main :: IO () 15 | main = hspec spec 16 | 17 | pF :: Proxy Filter 18 | pF = Proxy 19 | 20 | pT :: Proxy Transform 21 | pT = Proxy 22 | 23 | pS :: Proxy SideEffect 24 | pS = Proxy 25 | 26 | spec :: Spec 27 | spec = do 28 | describe "Split typeclass" $ do 29 | specify (label pF pF) $ shouldTypecheck (showSplit pF pF) 30 | specify (label pF pT) $ shouldTypecheck (showSplit pF pT) 31 | specify (label pF pS) $ shouldTypecheck (showSplit pF pS) 32 | specify (label pT pF) $ shouldTypecheck (showSplit pT pF) 33 | specify (label pT pT) $ shouldTypecheck (showSplit pT pT) 34 | specify (label pT pS) $ shouldTypecheck (showSplit pT pS) 35 | specify (label pS pF) $ shouldNotTypecheck (showSplit pS pF) 36 | specify (label pS pT) $ shouldNotTypecheck (showSplit pS pT) 37 | specify (label pS pS) $ shouldTypecheck (showSplit pS pS) 38 | describe "Lift typeclass" $ do 39 | specify (label pF pF) $ shouldTypecheck (showLift pF pF) 40 | specify (label pF pT) $ shouldTypecheck (showLift pF pT) 41 | specify (label pF pS) $ shouldTypecheck (showLift pF pS) 42 | specify (label pT pF) $ shouldNotTypecheck (showLift pT pF) 43 | specify (label pT pT) $ shouldTypecheck (showLift pT pT) 44 | specify (label pT pS) $ shouldTypecheck (showLift pT pS) 45 | specify (label pS pF) $ shouldNotTypecheck (showLift pS pF) 46 | specify (label pS pT) $ shouldNotTypecheck (showLift pS pT) 47 | specify (label pS pS) $ shouldTypecheck (showLift pS pS) 48 | 49 | 50 | label :: (WalkType a, WalkType b) => Proxy a -> Proxy b -> String 51 | label a b = showWalkType a ++ " -> " ++ showWalkType b 52 | 53 | shouldTypecheck :: String -> Expectation 54 | shouldTypecheck s = length s `shouldSatisfy` (> 0) 55 | -------------------------------------------------------------------------------- /greskell/test/graphson/edge_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "id" : 13, 3 | "label" : "develops", 4 | "type" : "edge", 5 | "inVLabel" : "software", 6 | "outVLabel" : "person", 7 | "inV" : 10, 8 | "outV" : 1, 9 | "properties" : { 10 | "since" : 2009 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /greskell/test/graphson/edge_v2.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:Edge", 3 | "@value" : { 4 | "id" : { 5 | "@type" : "g:Int32", 6 | "@value" : 13 7 | }, 8 | "label" : "develops", 9 | "inVLabel" : "software", 10 | "outVLabel" : "person", 11 | "inV" : { 12 | "@type" : "g:Int32", 13 | "@value" : 10 14 | }, 15 | "outV" : { 16 | "@type" : "g:Int32", 17 | "@value" : 1 18 | }, 19 | "properties" : { 20 | "since" : { 21 | "@type" : "g:Int32", 22 | "@value" : 2009 23 | } 24 | } 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /greskell/test/graphson/edge_v3.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:Edge", 3 | "@value" : { 4 | "id" : { 5 | "@type" : "g:Int32", 6 | "@value" : 13 7 | }, 8 | "label" : "develops", 9 | "inVLabel" : "software", 10 | "outVLabel" : "person", 11 | "inV" : { 12 | "@type" : "g:Int32", 13 | "@value" : 10 14 | }, 15 | "outV" : { 16 | "@type" : "g:Int32", 17 | "@value" : 1 18 | }, 19 | "properties" : { 20 | "since" : { 21 | "@type" : "g:Property", 22 | "@value" : { 23 | "key" : "since", 24 | "value" : { 25 | "@type" : "g:Int32", 26 | "@value" : 2009 27 | } 28 | } 29 | } 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /greskell/test/graphson/path_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "labels" : [ ["a"], ["b", "c"], [ ] ], 3 | "objects" : [ { 4 | "id" : 1, 5 | "label" : "person", 6 | "type" : "vertex", 7 | "properties" : { 8 | "name" : [ { 9 | "id" : 0, 10 | "value" : "marko" 11 | } ], 12 | "location" : [ { 13 | "id" : 6, 14 | "value" : "san diego", 15 | "properties" : { 16 | "startTime" : 1997, 17 | "endTime" : 2001 18 | } 19 | }, { 20 | "id" : 7, 21 | "value" : "santa cruz", 22 | "properties" : { 23 | "startTime" : 2001, 24 | "endTime" : 2004 25 | } 26 | }, { 27 | "id" : 8, 28 | "value" : "brussels", 29 | "properties" : { 30 | "startTime" : 2004, 31 | "endTime" : 2005 32 | } 33 | }, { 34 | "id" : 9, 35 | "value" : "santa fe", 36 | "properties" : { 37 | "startTime" : 2005 38 | } 39 | } ] 40 | } 41 | }, { 42 | "id" : 10, 43 | "label" : "software", 44 | "type" : "vertex", 45 | "properties" : { 46 | "name" : [ { 47 | "id" : 4, 48 | "value" : "gremlin" 49 | } ] 50 | } 51 | }, { 52 | "id" : 11, 53 | "label" : "software", 54 | "type" : "vertex", 55 | "properties" : { 56 | "name" : [ { 57 | "id" : 5, 58 | "value" : "tinkergraph" 59 | } ] 60 | } 61 | } ] 62 | } 63 | -------------------------------------------------------------------------------- /greskell/test/graphson/path_v2.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:Path", 3 | "@value" : { 4 | "labels" : [ ["a"], ["b", "c"], [ ] ], 5 | "objects" : [ { 6 | "@type" : "g:Vertex", 7 | "@value" : { 8 | "id" : { 9 | "@type" : "g:Int32", 10 | "@value" : 1 11 | }, 12 | "label" : "person" 13 | } 14 | }, { 15 | "@type" : "g:Vertex", 16 | "@value" : { 17 | "id" : { 18 | "@type" : "g:Int32", 19 | "@value" : 10 20 | }, 21 | "label" : "software", 22 | "properties" : { 23 | "name" : [ { 24 | "@type" : "g:VertexProperty", 25 | "@value" : { 26 | "id" : { 27 | "@type" : "g:Int64", 28 | "@value" : 4 29 | }, 30 | "value" : "gremlin", 31 | "vertex" : { 32 | "@type" : "g:Int32", 33 | "@value" : 10 34 | }, 35 | "label" : "name" 36 | } 37 | } ] 38 | } 39 | } 40 | }, { 41 | "@type" : "g:Vertex", 42 | "@value" : { 43 | "id" : { 44 | "@type" : "g:Int32", 45 | "@value" : 11 46 | }, 47 | "label" : "software", 48 | "properties" : { 49 | "name" : [ { 50 | "@type" : "g:VertexProperty", 51 | "@value" : { 52 | "id" : { 53 | "@type" : "g:Int64", 54 | "@value" : 5 55 | }, 56 | "value" : "tinkergraph", 57 | "vertex" : { 58 | "@type" : "g:Int32", 59 | "@value" : 11 60 | }, 61 | "label" : "name" 62 | } 63 | } ] 64 | } 65 | } 66 | } ] 67 | } 68 | } 69 | -------------------------------------------------------------------------------- /greskell/test/graphson/path_v3.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:Path", 3 | "@value" : { 4 | "labels" : { 5 | "@type" : "g:List", 6 | "@value" : [ { 7 | "@type" : "g:Set", 8 | "@value" : ["a"] 9 | }, { 10 | "@type" : "g:Set", 11 | "@value" : ["b", "c"] 12 | }, { 13 | "@type" : "g:Set", 14 | "@value" : [ ] 15 | } ] 16 | }, 17 | "objects" : { 18 | "@type" : "g:List", 19 | "@value" : [ { 20 | "@type" : "g:Vertex", 21 | "@value" : { 22 | "id" : { 23 | "@type" : "g:Int32", 24 | "@value" : 1 25 | }, 26 | "label" : "person" 27 | } 28 | }, { 29 | "@type" : "g:Vertex", 30 | "@value" : { 31 | "id" : { 32 | "@type" : "g:Int32", 33 | "@value" : 10 34 | }, 35 | "label" : "software" 36 | } 37 | }, { 38 | "@type" : "g:Vertex", 39 | "@value" : { 40 | "id" : { 41 | "@type" : "g:Int32", 42 | "@value" : 11 43 | }, 44 | "label" : "software" 45 | } 46 | } ] 47 | } 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /greskell/test/graphson/property_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "key" : "since", 3 | "value" : 2009 4 | } 5 | -------------------------------------------------------------------------------- /greskell/test/graphson/property_v2.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:Property", 3 | "@value" : { 4 | "key" : "since", 5 | "value" : { 6 | "@type" : "g:Int32", 7 | "@value" : 2009 8 | }, 9 | "element" : { 10 | "@type" : "g:Edge", 11 | "@value" : { 12 | "id" : { 13 | "@type" : "g:Int32", 14 | "@value" : 13 15 | }, 16 | "label" : "develops", 17 | "outV" : { 18 | "@type" : "g:Int32", 19 | "@value" : 1 20 | }, 21 | "inV" : { 22 | "@type" : "g:Int32", 23 | "@value" : 10 24 | } 25 | } 26 | } 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /greskell/test/graphson/property_v3.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:Property", 3 | "@value" : { 4 | "key" : "since", 5 | "value" : { 6 | "@type" : "g:Int32", 7 | "@value" : 2009 8 | } 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /greskell/test/graphson/vertex_property_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "id" : 0, 3 | "value" : "marko", 4 | "label" : "name" 5 | } 6 | -------------------------------------------------------------------------------- /greskell/test/graphson/vertex_property_v2.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:VertexProperty", 3 | "@value" : { 4 | "id" : { 5 | "@type" : "g:Int64", 6 | "@value" : 0 7 | }, 8 | "value" : "marko", 9 | "vertex" : { 10 | "@type" : "g:Int32", 11 | "@value" : 1 12 | }, 13 | "label" : "name" 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /greskell/test/graphson/vertex_property_v3.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:VertexProperty", 3 | "@value" : { 4 | "id" : { 5 | "@type" : "g:Int64", 6 | "@value" : 0 7 | }, 8 | "value" : "marko", 9 | "label" : "name" 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /greskell/test/graphson/vertex_v1.json: -------------------------------------------------------------------------------- 1 | { 2 | "id" : 1, 3 | "label" : "person", 4 | "type" : "vertex", 5 | "properties" : { 6 | "name" : [ { 7 | "id" : 0, 8 | "value" : "marko" 9 | } ], 10 | "location" : [ { 11 | "id" : 6, 12 | "value" : "san diego", 13 | "properties" : { 14 | "startTime" : 1997, 15 | "endTime" : 2001 16 | } 17 | }, { 18 | "id" : 7, 19 | "value" : "santa cruz", 20 | "properties" : { 21 | "startTime" : 2001, 22 | "endTime" : 2004 23 | } 24 | }, { 25 | "id" : 8, 26 | "value" : "brussels", 27 | "properties" : { 28 | "startTime" : 2004, 29 | "endTime" : 2005 30 | } 31 | }, { 32 | "id" : 9, 33 | "value" : "santa fe", 34 | "properties" : { 35 | "startTime" : 2005 36 | } 37 | } ] 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /greskell/test/graphson/vertex_v2.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:Vertex", 3 | "@value" : { 4 | "id" : { 5 | "@type" : "g:Int32", 6 | "@value" : 1 7 | }, 8 | "label" : "person", 9 | "properties" : { 10 | "name" : [ { 11 | "@type" : "g:VertexProperty", 12 | "@value" : { 13 | "id" : { 14 | "@type" : "g:Int64", 15 | "@value" : 0 16 | }, 17 | "value" : "marko", 18 | "vertex" : { 19 | "@type" : "g:Int32", 20 | "@value" : 1 21 | }, 22 | "label" : "name" 23 | } 24 | } ], 25 | "location" : [ { 26 | "@type" : "g:VertexProperty", 27 | "@value" : { 28 | "id" : { 29 | "@type" : "g:Int64", 30 | "@value" : 6 31 | }, 32 | "value" : "san diego", 33 | "vertex" : { 34 | "@type" : "g:Int32", 35 | "@value" : 1 36 | }, 37 | "label" : "location", 38 | "properties" : { 39 | "startTime" : { 40 | "@type" : "g:Int32", 41 | "@value" : 1997 42 | }, 43 | "endTime" : { 44 | "@type" : "g:Int32", 45 | "@value" : 2001 46 | } 47 | } 48 | } 49 | }, { 50 | "@type" : "g:VertexProperty", 51 | "@value" : { 52 | "id" : { 53 | "@type" : "g:Int64", 54 | "@value" : 7 55 | }, 56 | "value" : "santa cruz", 57 | "vertex" : { 58 | "@type" : "g:Int32", 59 | "@value" : 1 60 | }, 61 | "label" : "location", 62 | "properties" : { 63 | "startTime" : { 64 | "@type" : "g:Int32", 65 | "@value" : 2001 66 | }, 67 | "endTime" : { 68 | "@type" : "g:Int32", 69 | "@value" : 2004 70 | } 71 | } 72 | } 73 | }, { 74 | "@type" : "g:VertexProperty", 75 | "@value" : { 76 | "id" : { 77 | "@type" : "g:Int64", 78 | "@value" : 8 79 | }, 80 | "value" : "brussels", 81 | "vertex" : { 82 | "@type" : "g:Int32", 83 | "@value" : 1 84 | }, 85 | "label" : "location", 86 | "properties" : { 87 | "startTime" : { 88 | "@type" : "g:Int32", 89 | "@value" : 2004 90 | }, 91 | "endTime" : { 92 | "@type" : "g:Int32", 93 | "@value" : 2005 94 | } 95 | } 96 | } 97 | }, { 98 | "@type" : "g:VertexProperty", 99 | "@value" : { 100 | "id" : { 101 | "@type" : "g:Int64", 102 | "@value" : 9 103 | }, 104 | "value" : "santa fe", 105 | "vertex" : { 106 | "@type" : "g:Int32", 107 | "@value" : 1 108 | }, 109 | "label" : "location", 110 | "properties" : { 111 | "startTime" : { 112 | "@type" : "g:Int32", 113 | "@value" : 2005 114 | } 115 | } 116 | } 117 | } ] 118 | } 119 | } 120 | } 121 | -------------------------------------------------------------------------------- /greskell/test/graphson/vertex_v3.json: -------------------------------------------------------------------------------- 1 | { 2 | "@type" : "g:Vertex", 3 | "@value" : { 4 | "id" : { 5 | "@type" : "g:Int32", 6 | "@value" : 1 7 | }, 8 | "label" : "person", 9 | "properties" : { 10 | "name" : [ { 11 | "@type" : "g:VertexProperty", 12 | "@value" : { 13 | "id" : { 14 | "@type" : "g:Int64", 15 | "@value" : 0 16 | }, 17 | "value" : "marko", 18 | "label" : "name" 19 | } 20 | } ], 21 | "location" : [ { 22 | "@type" : "g:VertexProperty", 23 | "@value" : { 24 | "id" : { 25 | "@type" : "g:Int64", 26 | "@value" : 6 27 | }, 28 | "value" : "san diego", 29 | "label" : "location", 30 | "properties" : { 31 | "startTime" : { 32 | "@type" : "g:Int32", 33 | "@value" : 1997 34 | }, 35 | "endTime" : { 36 | "@type" : "g:Int32", 37 | "@value" : 2001 38 | } 39 | } 40 | } 41 | }, { 42 | "@type" : "g:VertexProperty", 43 | "@value" : { 44 | "id" : { 45 | "@type" : "g:Int64", 46 | "@value" : 7 47 | }, 48 | "value" : "santa cruz", 49 | "label" : "location", 50 | "properties" : { 51 | "startTime" : { 52 | "@type" : "g:Int32", 53 | "@value" : 2001 54 | }, 55 | "endTime" : { 56 | "@type" : "g:Int32", 57 | "@value" : 2004 58 | } 59 | } 60 | } 61 | }, { 62 | "@type" : "g:VertexProperty", 63 | "@value" : { 64 | "id" : { 65 | "@type" : "g:Int64", 66 | "@value" : 8 67 | }, 68 | "value" : "brussels", 69 | "label" : "location", 70 | "properties" : { 71 | "startTime" : { 72 | "@type" : "g:Int32", 73 | "@value" : 2004 74 | }, 75 | "endTime" : { 76 | "@type" : "g:Int32", 77 | "@value" : 2005 78 | } 79 | } 80 | } 81 | }, { 82 | "@type" : "g:VertexProperty", 83 | "@value" : { 84 | "id" : { 85 | "@type" : "g:Int64", 86 | "@value" : 9 87 | }, 88 | "value" : "santa fe", 89 | "label" : "location", 90 | "properties" : { 91 | "startTime" : { 92 | "@type" : "g:Int32", 93 | "@value" : 2005 94 | } 95 | } 96 | } 97 | } ] 98 | } 99 | } 100 | } 101 | -------------------------------------------------------------------------------- /run-janusgraph.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ## Run janusgraph docker container for testing. 4 | 5 | docker run --rm -p 8182:8182 janusgraph/janusgraph:0.4.0 6 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | ## resolver: lts-10.9 19 | resolver: lts-12.26 20 | 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # - location: 29 | # git: https://github.com/commercialhaskell/stack.git 30 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 31 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 32 | # extra-dep: true 33 | # subdirs: 34 | # - auto-update 35 | # - wai 36 | # 37 | # A package marked 'extra-dep: true' will only be built if demanded by a 38 | # non-dependency (i.e. a user package), and its test suites and benchmarks 39 | # will not be run. This is useful for tweaking upstream packages. 40 | packages: 41 | - greskell-core 42 | - greskell 43 | - greskell-websocket 44 | - test-readme 45 | 46 | # Dependency packages to be pulled from upstream that are not in the resolver 47 | # (e.g., acme-missiles-0.3) 48 | extra-deps: 49 | - hspec-need-env-0.1.0.6 50 | 51 | 52 | 53 | #### confirmed on 2018-03-12 54 | ## - aeson-1.3.0.0 55 | ## - QuickCheck-2.11.3 56 | ## - doctest-0.14.1 57 | ## - text-1.2.3.0 58 | ## - hspec-core-2.4.8 59 | ## - hspec-2.4.8 60 | ## - hspec-discover-2.4.8 61 | ## - hspec-expectations-0.8.2 62 | 63 | # Override default flag values for local packages and extra-deps 64 | flags: {} 65 | 66 | # Extra package databases containing global packages 67 | extra-package-dbs: [] 68 | 69 | # Control whether we use the GHC we find on the path 70 | # system-ghc: true 71 | # 72 | # Require a specific version of stack, using version ranges 73 | # require-stack-version: -any # Default 74 | # require-stack-version: ">=1.5" 75 | # 76 | # Override the architecture used by stack, especially useful on Windows 77 | # arch: i386 78 | # arch: x86_64 79 | # 80 | # Extra directories used by stack for building 81 | # extra-include-dirs: [/path/to/dir] 82 | # extra-lib-dirs: [/path/to/dir] 83 | # 84 | # Allow a newer minor version of GHC than the snapshot specifies 85 | # compiler-check: newer-minor 86 | -------------------------------------------------------------------------------- /test-readme/.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virthualenv 8 | .hsenv 9 | .cabal-sandbox/ 10 | cabal.sandbox.config 11 | .stack-work/ 12 | -------------------------------------------------------------------------------- /test-readme/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Toshio Ito 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Toshio Ito nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /test-readme/README.lhs: -------------------------------------------------------------------------------- 1 | ../README.md -------------------------------------------------------------------------------- /test-readme/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test-readme/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main 2 | ( main 3 | ) where 4 | 5 | main :: IO () 6 | main = return () 7 | -------------------------------------------------------------------------------- /test-readme/test-readme.cabal: -------------------------------------------------------------------------------- 1 | name: test-readme 2 | version: 0.1.0.1 3 | author: Toshio Ito 4 | maintainer: Toshio Ito 5 | license: BSD3 6 | license-file: LICENSE 7 | synopsis: test README 8 | description: test README. Longer. 9 | category: Test 10 | cabal-version: 2.0 11 | build-type: Simple 12 | -- extra-source-files: README.md, ChangeLog.md 13 | -- homepage: 14 | -- bug-reports: 15 | 16 | -- library 17 | -- default-language: Haskell2010 18 | -- hs-source-dirs: src 19 | -- ghc-options: -Wall -fno-warn-unused-imports 20 | -- build-depends: base >=4.9.0.0 && <4.12, 21 | -- text, 22 | -- aeson 23 | 24 | -- Dummy target to make cabal-install (run by travis) happy. 25 | executable test-readme-dummy 26 | default-language: Haskell2010 27 | hs-source-dirs: app 28 | main-is: Main.hs 29 | ghc-options: -Wall -fno-warn-unused-imports 30 | build-depends: base >=4.9.0.0 && <5.0 31 | 32 | 33 | test-suite readme-Greskell 34 | type: exitcode-stdio-1.0 35 | default-language: Haskell2010 36 | ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" -fno-warn-missing-signatures -pgmL markdown-unlit 37 | "-optL=common Greskell" 38 | main-is: README.lhs 39 | build-tool-depends: markdown-unlit:markdown-unlit 40 | build-depends: base, 41 | hspec, 42 | greskell, greskell-core, 43 | text, unordered-containers, aeson 44 | 45 | test-suite readme-Binder 46 | type: exitcode-stdio-1.0 47 | default-language: Haskell2010 48 | ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" -fno-warn-missing-signatures -pgmL markdown-unlit 49 | "-optL=common Binder" -fno-warn-unused-top-binds 50 | main-is: README.lhs 51 | build-tool-depends: markdown-unlit:markdown-unlit 52 | build-depends: base, 53 | hspec, 54 | greskell, greskell-core, 55 | text, unordered-containers, aeson 56 | 57 | test-suite readme-submit 58 | type: exitcode-stdio-1.0 59 | default-language: Haskell2010 60 | ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" -fno-warn-missing-signatures -pgmL markdown-unlit 61 | "-optL=common submit" -fno-warn-unused-top-binds 62 | main-is: README.lhs 63 | build-tool-depends: markdown-unlit:markdown-unlit 64 | build-depends: base, 65 | hspec, 66 | greskell, greskell-core, 67 | text, unordered-containers, aeson, 68 | greskell-websocket, 69 | safe-exceptions 70 | 71 | 72 | test-suite readme-GTraversal 73 | type: exitcode-stdio-1.0 74 | default-language: Haskell2010 75 | ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" -fno-warn-missing-signatures -pgmL markdown-unlit 76 | "-optL=common GTraversal" -fno-warn-type-defaults 77 | main-is: README.lhs 78 | build-tool-depends: markdown-unlit:markdown-unlit 79 | build-depends: base, 80 | hspec, 81 | greskell, greskell-core, 82 | text, unordered-containers, aeson 83 | 84 | test-suite readme-WalkType 85 | type: exitcode-stdio-1.0 86 | default-language: Haskell2010 87 | ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" -fno-warn-missing-signatures -pgmL markdown-unlit 88 | "-optL=common WalkType" -fno-warn-unused-top-binds 89 | main-is: README.lhs 90 | build-tool-depends: markdown-unlit:markdown-unlit 91 | build-depends: base, 92 | hspec, 93 | greskell, greskell-core, 94 | text, unordered-containers, aeson, 95 | greskell-websocket 96 | 97 | 98 | test-suite readme-monomorphic 99 | type: exitcode-stdio-1.0 100 | default-language: Haskell2010 101 | ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" -fno-warn-missing-signatures -pgmL markdown-unlit 102 | "-optL=common monomorphic" -fno-warn-unused-top-binds 103 | main-is: README.lhs 104 | build-tool-depends: markdown-unlit:markdown-unlit 105 | build-depends: base, 106 | hspec, 107 | greskell, greskell-core, 108 | text, unordered-containers, aeson 109 | 110 | test-suite readme-own_types2 111 | type: exitcode-stdio-1.0 112 | default-language: Haskell2010 113 | ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" -fno-warn-missing-signatures -pgmL markdown-unlit 114 | "-optL=common own_types2" -fno-warn-unused-top-binds -fno-warn-type-defaults 115 | main-is: README.lhs 116 | build-tool-depends: markdown-unlit:markdown-unlit 117 | build-depends: base, 118 | hspec, 119 | greskell, greskell-core, 120 | text, unordered-containers, aeson 121 | 122 | test-suite readme-graph_io 123 | type: exitcode-stdio-1.0 124 | default-language: Haskell2010 125 | ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" -fno-warn-missing-signatures -pgmL markdown-unlit 126 | "-optL=common graph_io" -fno-warn-unused-top-binds -fno-warn-type-defaults 127 | main-is: README.lhs 128 | build-tool-depends: markdown-unlit:markdown-unlit 129 | build-depends: base, 130 | hspec, 131 | greskell, greskell-core, 132 | text, unordered-containers, aeson, 133 | greskell-websocket, 134 | safe-exceptions, 135 | hspec-need-env 136 | 137 | --------------------------------------------------------------------------------