├── .gitignore ├── LICENSE ├── README.md ├── bower.json ├── shell.nix ├── src └── ChocoPie.purs └── test └── Main.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc* 7 | /.purs* 8 | /.psa* 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2017 Justin Woo 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Purescript-Choco-Pie 2 | 3 | [![Build Status](https://travis-ci.org/justinwoo/purescript-choco-pie.svg?branch=master)](https://travis-ci.org/justinwoo/purescript-choco-pie) 4 | 5 | [Docs on Pursuit](https://pursuit.purescript.org/packages/purescript-choco-pie) 6 | 7 | A Cycle.js-like utility for working with Purescript-Event. Aptly named for a circular Korean snack food. 8 | 9 | ![](http://i.imgur.com/uNCB4qp.jpg) 10 | 11 | ## Usage 12 | 13 | ```purs 14 | program = runChocoPie main' drivers 15 | where 16 | main' :: 17 | { a :: Event Int 18 | , b :: Unit 19 | } -> 20 | { a :: Event Unit 21 | , b :: Event Int 22 | } 23 | main' sources = 24 | { a: mempty 25 | , b: sources.a 26 | } 27 | 28 | drivers :: 29 | { a :: Event Unit -> Effect (Event Int) 30 | , b :: Event Int -> Effect Unit 31 | } 32 | drivers = 33 | { a: const $ pure (pure 1) 34 | , b: \events -> subscribe events logShow 35 | } 36 | ``` 37 | 38 | With appropriate context and individual annotations, the type signature annotations are no longer needed. 39 | 40 | ## Usage Exmples 41 | 42 | I rewrote some code in my [simple-rpc-telegram-bot](https://github.com/justinwoo/simple-rpc-telegram-bot/blob/6410ac4dd3baa20bc15229d48ebc8dfce5bc6b19/src/Main.purs#L169) repo, where I have drivers for running a child process, receiving and sending messages from Telegram, and a timer that ticks for every hour. 43 | 44 | ```purs 45 | type Main 46 | = { torscraper :: Event Result 47 | , bot :: Event Request 48 | , timer :: Event Request 49 | } 50 | -> { torscraper :: Event Request 51 | , bot :: Event Result 52 | , timer :: Event Unit 53 | } 54 | main' :: Main 55 | main' sources = 56 | { torscraper: sources.timer <|> sources.bot 57 | , bot: sources.torscraper 58 | , timer: mempty 59 | } 60 | 61 | drivers 62 | :: Config 63 | -> { torscraper :: Event Request -> Effect (Event Result) 64 | , bot :: Event Result -> Effect (Event Request) 65 | , timer :: Event Unit -> Effect (Event Request) 66 | } 67 | drivers 68 | { token 69 | , torscraperPath 70 | , master 71 | } = 72 | { torscraper 73 | , bot 74 | , timer 75 | } 76 | where 77 | torscraper requests = do 78 | { event, push } <- create 79 | _ <- subscribe requests $ handleTorscraper torscraperPath master push 80 | pure event 81 | 82 | bot results = do 83 | connection <- connect $ unwrap token 84 | _ <- subscribe results $ sendMessage' connection 85 | messages <- getMessages connection 86 | pure $ { origin: FromUser, id: master } <$ messages 87 | 88 | timer _ 89 | | tick <- pure unit <|> unit <$ interval (60 * 60 * 1000) 90 | , reqs <- { origin: FromTimer, id: master } <$ tick 91 | = pure reqs 92 | 93 | -- runChocoPie main' (drivers config) 94 | ``` 95 | 96 | I also have a simpler example in [atarime-purescript](https://github.com/justinwoo/atarime-purescript/blob/77b204a34bac95554a86aa4de1a9c36b3e22f1a0/src/Main.purs#L50) for similar usage of this library. 97 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-choco-pie", 3 | "license": "MIT", 4 | "repository": { 5 | "type": "git", 6 | "url": "git://github.com/justinwoo/purescript-chocopie.git" 7 | }, 8 | "ignore": [ 9 | "**/.*", 10 | "node_modules", 11 | "bower_components", 12 | "output" 13 | ], 14 | "dependencies": { 15 | "purescript-prelude": "^5.0.1", 16 | "purescript-typelevel-prelude": "^6.0.0", 17 | "purescript-record": "^3.0.0", 18 | "purescript-event": "justinwoo/purescript-event#^2.0.0" 19 | }, 20 | "devDependencies": { 21 | "purescript-assert": "^5.0.0" 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? import { } }: 2 | let 3 | easy-ps = import 4 | (pkgs.fetchFromGitHub { 5 | owner = "justinwoo"; 6 | repo = "easy-purescript-nix"; 7 | rev = "5716cd791c999b3246b4fe173276b42c50afdd8d"; 8 | sha256 = "1r9lx4xhr42znmwb2x2pzah920klbjbjcivp2f0pnka7djvd2adq"; 9 | }) { 10 | inherit pkgs; 11 | }; 12 | in 13 | pkgs.mkShell { 14 | buildInputs = [ 15 | easy-ps.purs 16 | easy-ps.psc-package 17 | ]; 18 | } 19 | -------------------------------------------------------------------------------- /src/ChocoPie.purs: -------------------------------------------------------------------------------- 1 | module ChocoPie where 2 | 3 | import Prelude 4 | 5 | import Data.Symbol (class IsSymbol, SProxy(..)) 6 | import Effect (Effect) 7 | import FRP.Event (Event, create, subscribe) 8 | import Prim.Row as Row 9 | import Prim.RowList (class RowToList, Cons, Nil, kind RowList) 10 | import Record as Record 11 | import Record.Builder (Builder) 12 | import Record.Builder as Builder 13 | import Type.Prelude (RLProxy(..)) 14 | 15 | runChocoPie :: forall driver sink source 16 | . ChocoPieRecord source sink driver 17 | => (Record source -> Record sink) 18 | -> Record driver 19 | -> Effect Unit 20 | runChocoPie = chocoPieItUp 21 | 22 | class ChocoPieRecord (source :: Row Type) (sink :: Row Type) (driver :: Row Type) 23 | | source -> sink driver where 24 | chocoPieItUp :: (Record source -> Record sink) -> (Record driver) -> Effect Unit 25 | 26 | instance chocoPieRecord :: 27 | ( RowToList driver driverL 28 | , RowToList sink sinkL 29 | , MakeSinkProxies sinkL () bundle 30 | , CallDrivers driverL driver bundle () source 31 | , ReplicateMany sinkL sink bundle 32 | ) => ChocoPieRecord source sink driver where 33 | chocoPieItUp main drivers = do 34 | sinkBuilder <- makeSinkProxies sinkLP 35 | let sinkProxies = Builder.build sinkBuilder {} 36 | sourcesBuilder <- callDrivers driverLP drivers sinkProxies 37 | let sinks = main (Builder.build sourcesBuilder {}) 38 | _ <- replicateMany sinkLP sinks sinkProxies 39 | pure unit 40 | where 41 | sinkLP = RLProxy :: RLProxy sinkL 42 | driverLP = RLProxy :: RLProxy driverL 43 | 44 | class MakeSinkProxies (sinkL :: RowList Type) (bundle' :: Row Type) (bundle :: Row Type) 45 | | sinkL -> bundle' bundle where 46 | makeSinkProxies :: RLProxy sinkL -> Effect (Builder (Record bundle') (Record bundle)) 47 | 48 | instance makeSinkProxiesCons :: 49 | ( IsSymbol name 50 | , MakeSinkProxies tail bundle'' bundle' 51 | , Row.Lacks name bundle' 52 | , Row.Cons name { event :: Event a, push :: a -> Effect Unit } bundle' bundle 53 | ) => MakeSinkProxies (Cons name (Event a) tail) bundle'' bundle where 54 | makeSinkProxies _ = compose 55 | <$> Builder.insert nameP <$> create 56 | <*> makeSinkProxies (RLProxy :: RLProxy tail) 57 | where 58 | nameP = SProxy :: SProxy name 59 | 60 | instance makeSinkProxiesNil :: MakeSinkProxies Nil () () where 61 | makeSinkProxies _ = pure identity 62 | 63 | class CallDrivers 64 | (driverL :: RowList Type) (driver :: Row Type) 65 | (bundle :: Row Type) (source' :: Row Type) (source :: Row Type) 66 | | driverL -> driver bundle source' source where 67 | callDrivers :: RLProxy driverL -> Record driver -> Record bundle -> Effect (Builder (Record source') (Record source)) 68 | 69 | instance callDriversCons :: 70 | ( IsSymbol name 71 | , CallDrivers driverTail driver bundle source'' source' 72 | , Row.Cons name (Event a -> Effect b) trash1 driver 73 | , Row.Cons name { event :: Event a, push :: a -> Effect Unit } trash2 bundle 74 | , Row.Lacks name source' 75 | , Row.Cons name b source' source 76 | ) => CallDrivers (Cons name driverton driverTail) driver bundle source'' source where 77 | callDrivers _ drivers bundle = compose 78 | <$> Builder.insert nameP <$> getSource 79 | <*> callDrivers (RLProxy :: RLProxy driverTail) drivers bundle 80 | where 81 | nameP = SProxy :: SProxy name 82 | bundleton = Record.get nameP bundle 83 | event = bundleton.event 84 | driver = Record.get nameP drivers 85 | getSource = driver event 86 | 87 | instance callDriversNil :: CallDrivers Nil driver bundle () () where 88 | callDrivers _ _ _ = pure identity 89 | 90 | class ReplicateMany 91 | (sinkL :: RowList Type) (sink :: Row Type) (bundle :: Row Type) 92 | | sinkL -> sink bundle where 93 | replicateMany :: RLProxy sinkL -> Record sink -> Record bundle -> Effect Unit 94 | 95 | instance replicateManyCons :: 96 | ( IsSymbol name 97 | , Row.Cons name (Event a) sink' sink 98 | , Row.Cons name { event :: Event a, push :: a -> Effect Unit } bundle' bundle 99 | , ReplicateMany tail sink bundle 100 | ) => ReplicateMany (Cons name (Event a) tail) sink bundle where 101 | replicateMany _ sinks bundles = do 102 | _ <- subscribe sink bundle.push 103 | replicateMany tailP sinks bundles 104 | where 105 | nameP = SProxy :: SProxy name 106 | sink = Record.get nameP sinks 107 | bundle :: { event :: Event a, push :: a -> Effect Unit} 108 | bundle = Record.get nameP bundles 109 | tailP = RLProxy :: RLProxy tail 110 | 111 | instance replicateManyNil :: ReplicateMany Nil sink bundle where 112 | replicateMany _ _ _ = pure unit 113 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import ChocoPie (runChocoPie) 6 | import Effect (Effect) 7 | import Effect.Console (logShow) 8 | import FRP.Event (Event, subscribe) 9 | import Test.Assert (assert) 10 | 11 | main :: Effect Unit 12 | main = do 13 | logShow "This program will run and print 1" 14 | program 15 | 16 | where 17 | program = do 18 | let 19 | drivers = 20 | { a: \_ -> pure (pure 1 :: Event Int) 21 | , b: \events -> 22 | void $ subscribe events \n -> do 23 | assert $ n == 1 24 | logShow n 25 | } 26 | runChocoPie main' drivers 27 | main' sources = 28 | { a: mempty :: Event Unit 29 | , b: sources.a 30 | } 31 | --------------------------------------------------------------------------------