mirror of
https://github.com/higherkindness/mu-haskell.git
synced 2024-09-11 14:36:01 +03:00
Work on route guide example
This commit is contained in:
parent
6cf7ee0522
commit
d504bae4f4
202
examples/route-guide/LICENSE
Normal file
202
examples/route-guide/LICENSE
Normal file
@ -0,0 +1,202 @@
|
||||
|
||||
Apache License
|
||||
Version 2.0, January 2004
|
||||
http://www.apache.org/licenses/
|
||||
|
||||
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
|
||||
|
||||
1. Definitions.
|
||||
|
||||
"License" shall mean the terms and conditions for use, reproduction,
|
||||
and distribution as defined by Sections 1 through 9 of this document.
|
||||
|
||||
"Licensor" shall mean the copyright owner or entity authorized by
|
||||
the copyright owner that is granting the License.
|
||||
|
||||
"Legal Entity" shall mean the union of the acting entity and all
|
||||
other entities that control, are controlled by, or are under common
|
||||
control with that entity. For the purposes of this definition,
|
||||
"control" means (i) the power, direct or indirect, to cause the
|
||||
direction or management of such entity, whether by contract or
|
||||
otherwise, or (ii) ownership of fifty percent (50%) or more of the
|
||||
outstanding shares, or (iii) beneficial ownership of such entity.
|
||||
|
||||
"You" (or "Your") shall mean an individual or Legal Entity
|
||||
exercising permissions granted by this License.
|
||||
|
||||
"Source" form shall mean the preferred form for making modifications,
|
||||
including but not limited to software source code, documentation
|
||||
source, and configuration files.
|
||||
|
||||
"Object" form shall mean any form resulting from mechanical
|
||||
transformation or translation of a Source form, including but
|
||||
not limited to compiled object code, generated documentation,
|
||||
and conversions to other media types.
|
||||
|
||||
"Work" shall mean the work of authorship, whether in Source or
|
||||
Object form, made available under the License, as indicated by a
|
||||
copyright notice that is included in or attached to the work
|
||||
(an example is provided in the Appendix below).
|
||||
|
||||
"Derivative Works" shall mean any work, whether in Source or Object
|
||||
form, that is based on (or derived from) the Work and for which the
|
||||
editorial revisions, annotations, elaborations, or other modifications
|
||||
represent, as a whole, an original work of authorship. For the purposes
|
||||
of this License, Derivative Works shall not include works that remain
|
||||
separable from, or merely link (or bind by name) to the interfaces of,
|
||||
the Work and Derivative Works thereof.
|
||||
|
||||
"Contribution" shall mean any work of authorship, including
|
||||
the original version of the Work and any modifications or additions
|
||||
to that Work or Derivative Works thereof, that is intentionally
|
||||
submitted to Licensor for inclusion in the Work by the copyright owner
|
||||
or by an individual or Legal Entity authorized to submit on behalf of
|
||||
the copyright owner. For the purposes of this definition, "submitted"
|
||||
means any form of electronic, verbal, or written communication sent
|
||||
to the Licensor or its representatives, including but not limited to
|
||||
communication on electronic mailing lists, source code control systems,
|
||||
and issue tracking systems that are managed by, or on behalf of, the
|
||||
Licensor for the purpose of discussing and improving the Work, but
|
||||
excluding communication that is conspicuously marked or otherwise
|
||||
designated in writing by the copyright owner as "Not a Contribution."
|
||||
|
||||
"Contributor" shall mean Licensor and any individual or Legal Entity
|
||||
on behalf of whom a Contribution has been received by Licensor and
|
||||
subsequently incorporated within the Work.
|
||||
|
||||
2. Grant of Copyright License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
copyright license to reproduce, prepare Derivative Works of,
|
||||
publicly display, publicly perform, sublicense, and distribute the
|
||||
Work and such Derivative Works in Source or Object form.
|
||||
|
||||
3. Grant of Patent License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
(except as stated in this section) patent license to make, have made,
|
||||
use, offer to sell, sell, import, and otherwise transfer the Work,
|
||||
where such license applies only to those patent claims licensable
|
||||
by such Contributor that are necessarily infringed by their
|
||||
Contribution(s) alone or by combination of their Contribution(s)
|
||||
with the Work to which such Contribution(s) was submitted. If You
|
||||
institute patent litigation against any entity (including a
|
||||
cross-claim or counterclaim in a lawsuit) alleging that the Work
|
||||
or a Contribution incorporated within the Work constitutes direct
|
||||
or contributory patent infringement, then any patent licenses
|
||||
granted to You under this License for that Work shall terminate
|
||||
as of the date such litigation is filed.
|
||||
|
||||
4. Redistribution. You may reproduce and distribute copies of the
|
||||
Work or Derivative Works thereof in any medium, with or without
|
||||
modifications, and in Source or Object form, provided that You
|
||||
meet the following conditions:
|
||||
|
||||
(a) You must give any other recipients of the Work or
|
||||
Derivative Works a copy of this License; and
|
||||
|
||||
(b) You must cause any modified files to carry prominent notices
|
||||
stating that You changed the files; and
|
||||
|
||||
(c) You must retain, in the Source form of any Derivative Works
|
||||
that You distribute, all copyright, patent, trademark, and
|
||||
attribution notices from the Source form of the Work,
|
||||
excluding those notices that do not pertain to any part of
|
||||
the Derivative Works; and
|
||||
|
||||
(d) If the Work includes a "NOTICE" text file as part of its
|
||||
distribution, then any Derivative Works that You distribute must
|
||||
include a readable copy of the attribution notices contained
|
||||
within such NOTICE file, excluding those notices that do not
|
||||
pertain to any part of the Derivative Works, in at least one
|
||||
of the following places: within a NOTICE text file distributed
|
||||
as part of the Derivative Works; within the Source form or
|
||||
documentation, if provided along with the Derivative Works; or,
|
||||
within a display generated by the Derivative Works, if and
|
||||
wherever such third-party notices normally appear. The contents
|
||||
of the NOTICE file are for informational purposes only and
|
||||
do not modify the License. You may add Your own attribution
|
||||
notices within Derivative Works that You distribute, alongside
|
||||
or as an addendum to the NOTICE text from the Work, provided
|
||||
that such additional attribution notices cannot be construed
|
||||
as modifying the License.
|
||||
|
||||
You may add Your own copyright statement to Your modifications and
|
||||
may provide additional or different license terms and conditions
|
||||
for use, reproduction, or distribution of Your modifications, or
|
||||
for any such Derivative Works as a whole, provided Your use,
|
||||
reproduction, and distribution of the Work otherwise complies with
|
||||
the conditions stated in this License.
|
||||
|
||||
5. Submission of Contributions. Unless You explicitly state otherwise,
|
||||
any Contribution intentionally submitted for inclusion in the Work
|
||||
by You to the Licensor shall be under the terms and conditions of
|
||||
this License, without any additional terms or conditions.
|
||||
Notwithstanding the above, nothing herein shall supersede or modify
|
||||
the terms of any separate license agreement you may have executed
|
||||
with Licensor regarding such Contributions.
|
||||
|
||||
6. Trademarks. This License does not grant permission to use the trade
|
||||
names, trademarks, service marks, or product names of the Licensor,
|
||||
except as required for reasonable and customary use in describing the
|
||||
origin of the Work and reproducing the content of the NOTICE file.
|
||||
|
||||
7. Disclaimer of Warranty. Unless required by applicable law or
|
||||
agreed to in writing, Licensor provides the Work (and each
|
||||
Contributor provides its Contributions) on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
|
||||
implied, including, without limitation, any warranties or conditions
|
||||
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
|
||||
PARTICULAR PURPOSE. You are solely responsible for determining the
|
||||
appropriateness of using or redistributing the Work and assume any
|
||||
risks associated with Your exercise of permissions under this License.
|
||||
|
||||
8. Limitation of Liability. In no event and under no legal theory,
|
||||
whether in tort (including negligence), contract, or otherwise,
|
||||
unless required by applicable law (such as deliberate and grossly
|
||||
negligent acts) or agreed to in writing, shall any Contributor be
|
||||
liable to You for damages, including any direct, indirect, special,
|
||||
incidental, or consequential damages of any character arising as a
|
||||
result of this License or out of the use or inability to use the
|
||||
Work (including but not limited to damages for loss of goodwill,
|
||||
work stoppage, computer failure or malfunction, or any and all
|
||||
other commercial damages or losses), even if such Contributor
|
||||
has been advised of the possibility of such damages.
|
||||
|
||||
9. Accepting Warranty or Additional Liability. While redistributing
|
||||
the Work or Derivative Works thereof, You may choose to offer,
|
||||
and charge a fee for, acceptance of support, warranty, indemnity,
|
||||
or other liability obligations and/or rights consistent with this
|
||||
License. However, in accepting such obligations, You may act only
|
||||
on Your own behalf and on Your sole responsibility, not on behalf
|
||||
of any other Contributor, and only if You agree to indemnify,
|
||||
defend, and hold each Contributor harmless for any liability
|
||||
incurred by, or claims asserted against, such Contributor by reason
|
||||
of your accepting any such warranty or additional liability.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
APPENDIX: How to apply the Apache License to your work.
|
||||
|
||||
To apply the Apache License to your work, attach the following
|
||||
boilerplate notice, with the fields enclosed by brackets "[]"
|
||||
replaced with your own identifying information. (Don't include
|
||||
the brackets!) The text should be enclosed in the appropriate
|
||||
comment syntax for the file format. We also recommend that a
|
||||
file or class name and description of purpose be included on the
|
||||
same "printed page" as the copyright notice for easier
|
||||
identification within third-party archives.
|
||||
|
||||
Copyright [yyyy] [name of copyright owner]
|
||||
|
||||
Licensed under the Apache License, Version 2.0 (the "License");
|
||||
you may not use this file except in compliance with the License.
|
||||
You may obtain a copy of the License at
|
||||
|
||||
http://www.apache.org/licenses/LICENSE-2.0
|
||||
|
||||
Unless required by applicable law or agreed to in writing, software
|
||||
distributed under the License is distributed on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
See the License for the specific language governing permissions and
|
||||
limitations under the License.
|
37
examples/route-guide/mu-example-route-guide.cabal
Normal file
37
examples/route-guide/mu-example-route-guide.cabal
Normal file
@ -0,0 +1,37 @@
|
||||
cabal-version: >=1.10
|
||||
-- Initial package description 'mu-haskell.cabal' generated by 'cabal
|
||||
-- init'. For further documentation, see
|
||||
-- http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: mu-example-route-guide
|
||||
version: 0.1.0.0
|
||||
-- synopsis:
|
||||
-- description:
|
||||
-- bug-reports:
|
||||
license: Apache-2.0
|
||||
license-file: LICENSE
|
||||
author: Alejandro Serrano
|
||||
maintainer: alejandro.serrano@47deg.com
|
||||
-- copyright:
|
||||
category: Network
|
||||
build-type: Simple
|
||||
|
||||
library
|
||||
exposed-modules: Definition
|
||||
build-depends: base >=4.12 && <5, text,
|
||||
mu-schema, mu-rpc, mu-grpc,
|
||||
hashable
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
||||
executable route-guide-server
|
||||
main-is: Server.hs
|
||||
other-modules: Definition
|
||||
build-depends: base >=4.12 && <5, text,
|
||||
mu-schema, mu-rpc, mu-grpc,
|
||||
stm, stm-chans, hashable,
|
||||
conduit, AC-Angle, time, async
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
46
examples/route-guide/routeguide.proto
Normal file
46
examples/route-guide/routeguide.proto
Normal file
@ -0,0 +1,46 @@
|
||||
syntax = "proto3";
|
||||
|
||||
package routeguide;
|
||||
|
||||
option java_multiple_files = true;
|
||||
option java_package = "io.grpc.examples.routeguide";
|
||||
option java_outer_classname = "RouteGuideProto";
|
||||
option objc_class_prefix = "RTG";
|
||||
|
||||
message Point {
|
||||
int32 latitude = 1;
|
||||
int32 longitude = 2;
|
||||
}
|
||||
|
||||
message Rectangle {
|
||||
Point lo = 1;
|
||||
Point hi = 2;
|
||||
}
|
||||
|
||||
message Feature {
|
||||
string name = 1;
|
||||
Point location = 2;
|
||||
}
|
||||
|
||||
message FeatureDatabase {
|
||||
repeated Feature feature = 1;
|
||||
}
|
||||
|
||||
message RouteNote {
|
||||
Point location = 1;
|
||||
string message = 2;
|
||||
}
|
||||
|
||||
message RouteSummary {
|
||||
int32 point_count = 1;
|
||||
int32 feature_count = 2;
|
||||
int32 distance = 3;
|
||||
int32 elapsed_time = 4;
|
||||
}
|
||||
|
||||
service RouteGuideService {
|
||||
rpc GetFeature (Point) returns (Feature);
|
||||
rpc ListFeatures (Rectangle) returns (stream Feature);
|
||||
rpc RecordRoute (stream Point) returns (RouteSummary);
|
||||
rpc RouteChat (stream RouteNote) returns (stream RouteNote);
|
||||
}
|
66
examples/route-guide/src/Definition.hs
Normal file
66
examples/route-guide/src/Definition.hs
Normal file
@ -0,0 +1,66 @@
|
||||
{-# language PolyKinds, DataKinds, TypeOperators,
|
||||
MultiParamTypeClasses, TypeFamilies,
|
||||
FlexibleInstances, FlexibleContexts,
|
||||
DeriveGeneric, DeriveAnyClass,
|
||||
DuplicateRecordFields #-}
|
||||
module Definition where
|
||||
|
||||
import GHC.Generics
|
||||
import Data.Hashable
|
||||
import Data.Int
|
||||
import Data.Text as T
|
||||
|
||||
import Mu.Schema
|
||||
import Mu.Schema.Adapter.ProtoBuf
|
||||
import Mu.Rpc
|
||||
|
||||
type RouteGuideSchema
|
||||
= '[ 'DRecord "Point" '[]
|
||||
'[ 'FieldDef "latitude" '[ProtoBufId 1] ('TPrimitive Int32)
|
||||
, 'FieldDef "longitude" '[ProtoBufId 2] ('TPrimitive Int32) ]
|
||||
, 'DRecord "Rectangle" '[]
|
||||
'[ 'FieldDef "lo" '[ProtoBufId 1] ('TSchematic "Point")
|
||||
, 'FieldDef "hi" '[ProtoBufId 2] ('TSchematic "Point") ]
|
||||
, 'DRecord "Feature" '[]
|
||||
'[ 'FieldDef "name" '[ProtoBufId 1] ('TPrimitive T.Text)
|
||||
, 'FieldDef "location" '[ProtoBufId 2] ('TSchematic "Point") ]
|
||||
, 'DRecord "FeatureDatabase" '[]
|
||||
'[ 'FieldDef "feature" '[ProtoBufId 1] ('TList ('TSchematic "Feature")) ]
|
||||
, 'DRecord "RouteNote" '[]
|
||||
'[ 'FieldDef "message" '[ProtoBufId 2] ('TPrimitive T.Text)
|
||||
, 'FieldDef "location" '[ProtoBufId 1] ('TSchematic "Point") ]
|
||||
, 'DRecord "RouteSummary" '[]
|
||||
'[ 'FieldDef "point_count" '[ProtoBufId 1] ('TPrimitive Int32)
|
||||
, 'FieldDef "feature_count" '[ProtoBufId 2] ('TPrimitive Int32)
|
||||
, 'FieldDef "distance" '[ProtoBufId 3] ('TPrimitive Int32)
|
||||
, 'FieldDef "elapsed_time" '[ProtoBufId 4] ('TPrimitive Int32) ]
|
||||
]
|
||||
|
||||
data Point
|
||||
= Point { latitude, longitude :: Int32 }
|
||||
deriving (Eq, Show, Ord, Generic, Hashable, HasSchema RouteGuideSchema "Point")
|
||||
data Rectangle
|
||||
= Rectangle { lo, hi :: Point }
|
||||
deriving (Eq, Show, Ord, Generic, HasSchema RouteGuideSchema "Rectangle")
|
||||
data Feature
|
||||
= Feature { name :: T.Text, location :: Point }
|
||||
deriving (Eq, Show, Ord, Generic, HasSchema RouteGuideSchema "Feature")
|
||||
-- Not used in the service
|
||||
-- newtype FeatureDb
|
||||
-- = FeatureDb { feature :: [Feature] }
|
||||
-- deriving (Eq, Show, Ord, Generic, HasSchema RouteGuideSchema "FeatureDatabase")
|
||||
data RouteNote
|
||||
= RouteNote { message :: T.Text, location :: Point }
|
||||
deriving (Eq, Show, Ord, Generic, HasSchema RouteGuideSchema "RouteNote")
|
||||
data RouteSummary
|
||||
= RouteSummary { point_count, feature_count, distance, elapsed_time :: Int32 }
|
||||
deriving (Eq, Show, Ord, Generic, HasSchema RouteGuideSchema "RouteSummary")
|
||||
|
||||
type RG = 'FromSchema RouteGuideSchema
|
||||
type RouteGuideService
|
||||
= 'Service "RouteGuideService" '[Package "routeguide"]
|
||||
'[ 'Method "GetFeature" '[] '[ 'ArgSingle (RG "Point") ] ('RetSingle (RG "Feature"))
|
||||
, 'Method "ListFeatures" '[] '[ 'ArgSingle (RG "Rectangle") ] ('RetStream (RG "Feature"))
|
||||
, 'Method "RecordRoute" '[] '[ 'ArgStream (RG "Point") ] ('RetSingle (RG "RouteSummary"))
|
||||
, 'Method "RouteChat" '[] '[ 'ArgStream (RG "RouteNote") ] ('RetStream (RG "RouteNote"))
|
||||
]
|
118
examples/route-guide/src/Server.hs
Normal file
118
examples/route-guide/src/Server.hs
Normal file
@ -0,0 +1,118 @@
|
||||
{-# language OverloadedStrings, PartialTypeSignatures,
|
||||
DuplicateRecordFields, ScopedTypeVariables #-}
|
||||
module Main where
|
||||
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
import Control.Concurrent.STM.TBMChan
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Angle
|
||||
import Data.Conduit
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
import Data.Conduit.List (sourceList)
|
||||
import Data.Function ((&))
|
||||
import Data.Int
|
||||
import Data.List (find)
|
||||
import Data.Maybe
|
||||
import Data.Time.Clock
|
||||
|
||||
import Mu.Server
|
||||
import Mu.Server.GRpc
|
||||
|
||||
import Definition
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "running route guide application"
|
||||
let features = []
|
||||
routeNotes <- newTBMChanIO 100
|
||||
runGRpcApp 8080 (server features routeNotes)
|
||||
|
||||
-- Utilities
|
||||
-- https://github.com/higherkindness/mu/blob/master/modules/examples/routeguide/common/src/main/scala/Utils.scala
|
||||
|
||||
type Features = [Feature]
|
||||
|
||||
findFeatureIn :: Features -> Point -> Maybe Feature
|
||||
findFeatureIn features p
|
||||
= find (\(Feature _ loc) -> loc == p) features
|
||||
|
||||
withinBounds :: Rectangle -> Point -> Bool
|
||||
withinBounds (Rectangle (Point lox loy) (Point hix hiy)) (Point x y)
|
||||
= x >= lox && x <= hix && y >= loy && y <= hiy
|
||||
|
||||
featuresWithinBounds :: Features -> Rectangle -> Features
|
||||
featuresWithinBounds fs rect
|
||||
= filter (\(Feature _ loc) -> withinBounds rect loc) fs
|
||||
|
||||
calcDistance :: Point -> Point -> Int32
|
||||
calcDistance (Point lat1 lon1) (Point lat2 lon2)
|
||||
= let r = 6371000
|
||||
Radians (phi1 :: Double) = radians (Degrees (int32ToDouble lat1))
|
||||
Radians (phi2 :: Double) = radians (Degrees (int32ToDouble lat2))
|
||||
Radians (deltaPhi :: Double) = radians (Degrees (int32ToDouble $ lat2 - lat1))
|
||||
Radians (deltaLambda :: Double) = radians (Degrees (int32ToDouble $ lon2 - lon1))
|
||||
a = sin (deltaPhi / 2) * sin (deltaPhi / 2)
|
||||
+ cos phi1 * cos phi2 * sin (deltaLambda / 2) * sin (deltaLambda / 2)
|
||||
c = 2 * atan2 (sqrt a) (sqrt (1 - a))
|
||||
in fromInteger $ r * ceiling c
|
||||
where int32ToDouble :: Int32 -> Double
|
||||
int32ToDouble = fromInteger . toInteger
|
||||
|
||||
-- Server implementation
|
||||
-- https://github.com/higherkindness/mu/blob/master/modules/examples/routeguide/server/src/main/scala/handlers/RouteGuideServiceHandler.scala
|
||||
|
||||
server :: Features -> TBMChan RouteNote -> ServerIO RouteGuideService _
|
||||
server f m
|
||||
= Server (getFeature f :<|>: listFeatures f
|
||||
:<|>: recordRoute f :<|>: routeChat m :<|>: H0)
|
||||
|
||||
getFeature :: Features -> Point -> IO Feature
|
||||
getFeature fs p
|
||||
= return $ fromMaybe (Feature "" (Point 0 0)) (findFeatureIn fs p)
|
||||
|
||||
listFeatures :: Features -> Rectangle -> ConduitT Feature Void IO () -> IO ()
|
||||
listFeatures fs rect result
|
||||
= runConduit $ sourceList (featuresWithinBounds fs rect) .| result
|
||||
|
||||
recordRoute :: Features -> ConduitT () Point IO () -> IO RouteSummary
|
||||
recordRoute fs ps
|
||||
= do initialTime <- getCurrentTime
|
||||
(rs, _, _) <- runConduit $ ps .| C.foldM step (RouteSummary 0 0 0 0, Nothing, initialTime)
|
||||
return rs
|
||||
where step :: (RouteSummary, Maybe Point, UTCTime) -> Point -> IO (RouteSummary, Maybe Point, UTCTime)
|
||||
step (summary, previous, startTime) point
|
||||
= do currentTime <- getCurrentTime
|
||||
let feature = findFeatureIn fs point
|
||||
new_distance = fmap (`calcDistance` point) previous & fromMaybe 0
|
||||
new_elapsed = diffUTCTime currentTime startTime
|
||||
new_summary = RouteSummary (point_count summary + 1)
|
||||
(feature_count summary + if isJust feature then 1 else 0)
|
||||
(distance summary + new_distance)
|
||||
(floor new_elapsed)
|
||||
return (new_summary, Just point, startTime)
|
||||
|
||||
routeChat :: TBMChan RouteNote
|
||||
-> ConduitT () RouteNote IO () -> ConduitT RouteNote Void IO () -> IO ()
|
||||
routeChat notesMap inS outS
|
||||
= do toWatch <- newEmptyTMVarIO
|
||||
-- Start two threads, one to listen, one to send
|
||||
inA <- async $ runConduit $ inS .| C.mapM_ (addNoteToMap toWatch)
|
||||
outA <- async $ runConduit $ readStmMap (\l1 (RouteNote _ l2)-> l1 == l2) toWatch notesMap .| outS
|
||||
wait inA
|
||||
wait outA
|
||||
where addNoteToMap :: TMVar Point -> RouteNote -> IO ()
|
||||
addNoteToMap toWatch newNote@(RouteNote _ loc)
|
||||
= atomically $ do _ <- tryTakeTMVar toWatch
|
||||
putTMVar toWatch loc
|
||||
writeTBMChan notesMap newNote
|
||||
|
||||
readStmMap :: Show b => (a -> b -> Bool) -> TMVar a -> TBMChan b -> ConduitT () b IO ()
|
||||
readStmMap p toWatch m = go
|
||||
where
|
||||
go = do
|
||||
v <- liftIO $ atomically $ (,) <$> readTBMChan m <*> tryReadTMVar toWatch
|
||||
case v of
|
||||
(Nothing, _) -> return ()
|
||||
(Just v', Just e') | p e' v' -> liftIO (print v') >> yield v' >> go
|
||||
_ -> go
|
@ -5,6 +5,7 @@ packages:
|
||||
- rpc
|
||||
- grpc
|
||||
- examples/health-check
|
||||
- examples/route-guide
|
||||
|
||||
extra-deps:
|
||||
- proto3-wire-1.0.0
|
||||
@ -14,6 +15,7 @@ extra-deps:
|
||||
- primitive-unlifted-0.1.2.0
|
||||
- stm-hamt-1.2.0.4
|
||||
- stm-containers-1.1.0.4
|
||||
- AC-Angle-1.0
|
||||
- git: https://github.com/serras/avro.git
|
||||
commit: 7ba39ebb6b74c64fffb3d3a972b4000185579f19
|
||||
- git: https://github.com/higherkindness/http2-grpc-haskell.git
|
||||
|
Loading…
Reference in New Issue
Block a user