Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,4 @@
/bower_components/
/node_modules/
/output/
package-lock.json
42 changes: 23 additions & 19 deletions LICENSE
Original file line number Diff line number Diff line change
@@ -1,22 +1,26 @@
Copyright (c) 2014-15 PureScript
Copyright 2018 PureScript

Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the "Software"), to deal in the Software without
restriction, including without limitation the rights to use,
copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following
conditions:
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:

The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.

3. Neither the name of the copyright holder nor the names of its contributors
may be used to endorse or promote products derived from this software without
specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
21 changes: 13 additions & 8 deletions bower.json
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
{
"name": "purescript-parallel",
"description": "Type classes for parallel computation",
"license": "MIT",
"license": "BSD-3-Clause",
"repository": {
"type": "git",
"url": "git://github.com/purescript/purescript-parallel.git"
Expand All @@ -16,13 +15,19 @@
"package.json"
],
"dependencies": {
"purescript-transformers": "^3.0.0",
"purescript-refs": "^3.0.0",
"purescript-functors": "^2.0.0",
"purescript-foldable-traversable": "^3.6.0"
"purescript-control": "^4.0.0",
"purescript-effect": "^2.0.0",
"purescript-either": "^4.0.0",
"purescript-foldable-traversable": "^4.0.0",
"purescript-functors": "^3.0.0",
"purescript-maybe": "^4.0.0",
"purescript-newtype": "^3.0.0",
"purescript-prelude": "^4.0.0",
"purescript-refs": "^4.0.0",
"purescript-transformers": "^4.0.0"
},
"devDependencies": {
"purescript-console": "^3.0.0",
"purescript-functions": "^3.0.0"
"purescript-console": "^4.0.0",
"purescript-functions": "^4.0.0"
}
}
6 changes: 3 additions & 3 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,8 @@
"test": "pulp test"
},
"devDependencies": {
"pulp": "^10.0.4",
"purescript-psa": "^0.5.0-rc.1",
"rimraf": "^2.6.1"
"pulp": "^12.2.0",
"purescript-psa": "^0.6.0",
"rimraf": "^2.6.2"
}
}
9 changes: 4 additions & 5 deletions src/Control/Parallel.purs
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
module Control.Parallel
( parTraverse
( parApply
, parTraverse
, parTraverse_
, parSequence
, parSequence_
, parOneOf
, parOneOfMap
, parApply
, module Control.Parallel.Class
) where

Expand All @@ -26,7 +26,6 @@ parApply
-> m b
parApply mf ma = sequential(apply (parallel mf) (parallel ma))


-- | Traverse a collection in parallel.
parTraverse
:: forall f m t a b
Expand All @@ -53,15 +52,15 @@ parSequence
=> Traversable t
=> t (m a)
-> m (t a)
parSequence = parTraverse id
parSequence = parTraverse identity

parSequence_
:: forall a t m f
. Parallel f m
=> Foldable t
=> t (m a)
-> m Unit
parSequence_ = parTraverse_ id
parSequence_ = parTraverse_ identity

-- | Race a collection in parallel.
parOneOf
Expand Down
56 changes: 22 additions & 34 deletions src/Control/Parallel/Class.purs
Original file line number Diff line number Diff line change
@@ -1,35 +1,26 @@
module Control.Parallel.Class
( class Parallel
, parallel
, sequential
, ParCont(..)
) where
module Control.Parallel.Class where

import Prelude

import Control.Alt (class Alt)
import Control.Alternative (class Alternative)
import Control.Monad.Cont.Trans (ContT(..), runContT)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (class MonadEff, liftEff)
import Control.Monad.Eff.Ref (REF, writeRef, readRef, newRef)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import Control.Monad.Except.Trans (ExceptT(..))
import Control.Monad.Maybe.Trans (MaybeT(..))
import Control.Monad.Reader.Trans (mapReaderT, ReaderT)
import Control.Monad.Writer.Trans (mapWriterT, WriterT)
import Control.Plus (class Plus)

import Data.Either (Either)
import Data.Functor.Compose (Compose(..))
import Data.Maybe (Maybe(..))
import Data.Monoid (class Monoid)
import Data.Newtype (class Newtype)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Ref as Ref

-- | The `Parallel` class abstracts over monads which support
-- | parallel composition via some related `Applicative`.
class (Monad m, Applicative f) <= Parallel f m | m -> f, f -> m where
parallel :: m ~> f
parallel :: m ~> f
sequential :: f ~> m

instance monadParExceptT :: Parallel f m => Parallel (Compose f (Either e)) (ExceptT e m) where
Expand Down Expand Up @@ -67,57 +58,54 @@ newtype ParCont m a = ParCont (ContT Unit m a)

derive instance newtypeParCont :: Newtype (ParCont m a) _

instance functorParCont :: MonadEff eff m => Functor (ParCont m) where
instance functorParCont :: MonadEffect m => Functor (ParCont m) where
map f = parallel <<< map f <<< sequential

instance applyParCont :: MonadEff eff m => Apply (ParCont m) where
instance applyParCont :: MonadEffect m => Apply (ParCont m) where
apply (ParCont ca) (ParCont cb) = ParCont $ ContT \k -> do
ra <- liftEff $ unsafeWithRef (newRef Nothing)
rb <- liftEff $ unsafeWithRef (newRef Nothing)
ra <- liftEffect (Ref.new Nothing)
rb <- liftEffect (Ref.new Nothing)

runContT ca \a -> do
mb <- liftEff $ unsafeWithRef (readRef rb)
mb <- liftEffect (Ref.read rb)
case mb of
Nothing -> liftEff $ unsafeWithRef (writeRef ra (Just a))
Nothing -> liftEffect (Ref.write (Just a) ra)
Just b -> k (a b)

runContT cb \b -> do
ma <- liftEff $ unsafeWithRef (readRef ra)
ma <- liftEffect (Ref.read ra)
case ma of
Nothing -> liftEff $ unsafeWithRef (writeRef rb (Just b))
Nothing -> liftEffect (Ref.write (Just b) rb)
Just a -> k (a b)

instance applicativeParCont :: MonadEff eff m => Applicative (ParCont m) where
instance applicativeParCont :: MonadEffect m => Applicative (ParCont m) where
pure = parallel <<< pure

instance altParCont :: MonadEff eff m => Alt (ParCont m) where
instance altParCont :: MonadEffect m => Alt (ParCont m) where
alt (ParCont c1) (ParCont c2) = ParCont $ ContT \k -> do
done <- liftEff $ unsafeWithRef (newRef false)
done <- liftEffect (Ref.new false)

runContT c1 \a -> do
b <- liftEff $ unsafeWithRef (readRef done)
b <- liftEffect (Ref.read done)
if b
then pure unit
else do
liftEff $ unsafeWithRef (writeRef done true)
liftEffect (Ref.write true done)
k a

runContT c2 \a -> do
b <- liftEff $ unsafeWithRef (readRef done)
b <- liftEffect (Ref.read done)
if b
then pure unit
else do
liftEff $ unsafeWithRef (writeRef done true)
liftEffect (Ref.write true done)
k a

instance plusParCont :: MonadEff eff m => Plus (ParCont m) where
instance plusParCont :: MonadEffect m => Plus (ParCont m) where
empty = ParCont $ ContT \_ -> pure unit

instance alternativeParCont :: MonadEff eff m => Alternative (ParCont m)
instance alternativeParCont :: MonadEffect m => Alternative (ParCont m)

instance monadParParCont :: MonadEff eff m => Parallel (ParCont m) (ContT Unit m) where
instance monadParParCont :: MonadEffect m => Parallel (ParCont m) (ContT Unit m) where
parallel = ParCont
sequential (ParCont ma) = ma

unsafeWithRef :: forall eff a. Eff (ref :: REF | eff) a -> Eff eff a
unsafeWithRef = unsafeCoerceEff
18 changes: 6 additions & 12 deletions test/Main.purs
Original file line number Diff line number Diff line change
@@ -1,32 +1,26 @@
module Test.Main where

import Prelude (Unit, (<<<))
import Prelude

import Control.Monad.Cont.Trans (ContT(..), runContT)
import Control.Monad.Eff (Eff, kind Effect)
import Control.Monad.Eff.Console (CONSOLE, logShow)
import Control.Parallel (parTraverse)
import Effect (Effect)
import Effect.Console (logShow)

newtype Request = Request
{ host :: String
, path :: String
}

foreign import data HTTP :: Effect
foreign import getImpl :: Request -> (String -> Effect Unit) -> Effect Unit

foreign import getImpl
:: forall eff
. Request
-> (String -> Eff (http :: HTTP | eff) Unit)
-> Eff (http :: HTTP | eff) Unit

get :: forall eff. Request -> ContT Unit (Eff (http :: HTTP | eff)) String
get :: Request -> ContT Unit Effect String
get req = ContT (getImpl req)

request :: String -> Request
request host = Request { host: host, path: "/" }

main :: forall eff. Eff (http :: HTTP, console :: CONSOLE | eff) Unit
main :: Effect Unit
main = runContT (parTraverse (get <<< request) resources) logShow
where
resources :: Array String
Expand Down