Merge pull request #4 from TinkerTravel/master

psc 0.10 support and IOSync

Author: jdegoes

README.md

@@ -43,7 +43,7 @@ Similarly, if we were using `Free` directly, instead of using type classes to ab
 ```haskell
 data ConfigF a
   = ReadConfig (Config -> a)
-  
+
 serverAddress :: ReaderT (PrismT' f ConfigF) (Free f) InetAddress
 ```
 
@@ -55,7 +55,7 @@ Therefore, MTL and direct-Free approaches can be considered alternatives to Pure
 
 # Usage
 
-`IO` only has one function, which should only be used in your `main`:
+`IO` is a newtype for `Aff`, which you can unwrap to be used in your `main`:
 
 ```haskell
 runIO :: forall a. IO a -> Aff (infinity :: INFINITY) a
@@ -72,4 +72,6 @@ Besides this, `IO` has almost all the same instances as `Aff`, and may be used
 in the same way. In addition, a new `MonadIO` class has been introduced which
 allows you to lift `IO` computations into other monads that are as powerful.
 
+Similarly, `IOSync` exists as an alternative for `Eff`.
+
 Happy nuke launching!

bower.json

@@ -7,9 +7,17 @@
     "output"
   ],
   "dependencies": {
-    "purescript-aff": "1.1.0"
+    "purescript-aff": "^2.0.3",
+    "purescript-control": "^2.0.0",
+    "purescript-eff": "^2.0.0",
+    "purescript-exceptions": "^2.0.0",
+    "purescript-monoid": "^2.2.0",
+    "purescript-newtype": "^1.3.0",
+    "purescript-prelude": "^2.5.0",
+    "purescript-tailrec": "^2.0.2",
+    "purescript-transformers": "^2.3.0"
   },
   "devDependencies": {
-    "purescript-psci-support": "^1.0.0"
+    "purescript-psci-support": "^2.0.0"
   }
 }

src/Control/Monad/IO.purs

@@ -1,87 +1,66 @@
-module Control.Monad.IO (IO, INFINITY, AffIO(..), runIO) where
-  import Prelude
+module Control.Monad.IO
+  ( module Control.Monad.IO.Effect
+  , IO(..)
+  , runIO
+  , runIO'
+  , launchIO
+  ) where
 
-  import Control.Alt (class Alt, alt)
-  import Control.Alternative (class Alternative)
-  import Control.Monad.Eff (Eff)
-  import Control.Monad.Eff.Class (class MonadEff, liftEff)
-  import Control.Monad.Aff (Aff)
-  import Control.Monad.Aff.Class (class MonadAff)
-  import Control.Monad.Eff.Exception (Error)
-  import Control.Monad.Error.Class (class MonadError, throwError, catchError)
-  import Control.Monad.Rec.Class (class MonadRec, tailRecM)
-  import Control.MonadPlus (class MonadZero, class MonadPlus, empty)
-  import Control.Parallel.Class (class MonadRace, class MonadPar, par, race, stall)
-  import Control.Plus (class Plus)
+import Control.Alt (class Alt)
+import Control.Alternative (class Alternative)
+import Control.Monad.Aff (Aff, launchAff)
+import Control.Monad.Aff.Class (class MonadAff)
+import Control.Monad.Aff.Unsafe (unsafeCoerceAff)
+import Control.Monad.Eff.Class (class MonadEff, liftEff)
+import Control.Monad.Eff.Exception (Error)
+import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
+import Control.Monad.Error.Class (class MonadError)
+import Control.Monad.IO.Effect (INFINITY)
+import Control.Monad.IOSync (IOSync)
+import Control.Monad.Rec.Class (class MonadRec)
+import Control.MonadZero (class MonadZero)
+import Control.Plus (class Plus)
+import Data.Monoid (class Monoid)
+import Data.Newtype (class Newtype, unwrap, wrap)
+import Prelude
 
-  import Data.Monoid (class Monoid, mempty)
+newtype IO a = IO (Aff (infinity :: INFINITY) a)
 
-  import Unsafe.Coerce (unsafeCoerce)
+runIO :: IO ~> Aff (infinity :: INFINITY)
+runIO = unwrap
 
-  foreign import data IO :: * -> *
+runIO' :: ∀ eff. IO ~> Aff (infinity :: INFINITY | eff)
+runIO' = unsafeCoerceAff <<< unwrap
 
-  foreign import data INFINITY :: !
+launchIO :: ∀ a. IO a -> IOSync Unit
+launchIO = void <<< liftEff <<< launchAff <<< unwrap
 
-  type AffIO a = Aff (infinity :: INFINITY) a
+derive instance newtypeIO :: Newtype (IO a) _
 
-  runIO :: forall a. IO a -> AffIO a
-  runIO = unsafeCoerce
+derive newtype instance functorIO     :: Functor     IO
+derive newtype instance applyIO       :: Apply       IO
+derive newtype instance applicativeIO :: Applicative IO
+derive newtype instance bindIO        :: Bind        IO
+derive newtype instance monadIO       :: Monad       IO
 
-  toIO :: forall e a. Aff e a -> IO a
-  toIO = unsafeCoerce
+derive newtype instance monadRecIO :: MonadRec IO
 
-  instance semigroupIO :: (Semigroup a) => Semigroup (IO a) where
-    append a b = toIO (append (runIO a) (runIO b))
+derive newtype instance semigroupIO :: (Semigroup a) => Semigroup (IO a)
 
-  instance monoidIO :: (Monoid a) => Monoid (IO a) where
-    mempty = toIO (pure mempty)
+derive newtype instance monoidIO :: (Monoid a) => Monoid (IO a)
 
-  instance functorIO :: Functor IO where
-    map f fa = toIO (map f (runIO fa))
+instance monadAffIO :: MonadAff eff IO where
+  liftAff = wrap <<< unsafeCoerceAff
 
-  instance applyIO :: Apply IO where
-    apply ff fa = toIO (apply (runIO ff) (runIO fa))
+instance monadEffIO :: MonadEff eff IO where
+  liftEff = wrap <<< liftEff <<< unsafeCoerceEff
 
-  instance applicativeIO :: Applicative IO where
-    pure v = toIO (pure v)
+derive newtype instance monadErrorIO :: MonadError Error IO
 
-  instance bindIO :: Bind IO where
-    bind fa f = toIO (bind (runIO fa) (unsafeCoerce f))
+derive newtype instance altIO :: Alt IO
 
-  instance monadIO :: Monad IO
+derive newtype instance plusIO :: Plus IO
 
-  instance monadEffIO :: MonadEff e IO where
-    liftEff = liftEff'
-      where
-        liftEff' :: forall a. Eff e a -> IO a
-        liftEff' eff = toIO (liftEff eff :: Aff e a)
+derive newtype instance alternativeIO :: Alternative IO
 
-  instance monadAffIO :: MonadAff e IO where
-    liftAff = toIO
-
-  instance monadErrorIO :: MonadError Error IO where
-    throwError e = toIO (throwError e)
-
-    catchError io f = toIO (catchError (runIO io) (runIO <$> f))
-
-  instance altIO :: Alt IO where
-    alt a1 a2 = toIO (alt (runIO a1) (runIO a2))
-
-  instance plusIO :: Plus IO where
-    empty = toIO empty
-
-  instance alternativeIO :: Alternative IO
-
-  instance monadZero :: MonadZero IO
-
-  instance monadPlusIO :: MonadPlus IO
-
-  instance monadRecIO :: MonadRec IO where
-    tailRecM f a = toIO (tailRecM (unsafeCoerce f) a)
-
-  instance monadParIO :: MonadPar IO where
-    par f ma mb = toIO (par f (runIO ma) (runIO mb))
-
-  instance monadRaceIO :: MonadRace IO where
-    stall = toIO stall
-    race a1 a2 = toIO (race (runIO a1) (runIO a2))
+derive newtype instance monadZeroIO :: MonadZero IO

src/Control/Monad/IO/Class.purs

@@ -1,10 +1,10 @@
 module Control.Monad.IO.Class where
-  import Control.Category (id)
-  import Control.Monad (class Monad)
-  import Control.Monad.IO (IO)
 
-  class Monad m <= MonadIO m where
-    liftIO :: forall a. IO a -> m a
+import Control.Monad.IO (IO)
+import Prelude
 
-  instance monadIOIO :: MonadIO IO where
-    liftIO = id
+class (Monad m) <= MonadIO m where
+  liftIO :: IO ~> m
+
+instance monadIOIO :: MonadIO IO where
+  liftIO = id

src/Control/Monad/IO/Effect.purs

@@ -0,0 +1,5 @@
+module Control.Monad.IO.Effect
+  ( INFINITY
+  ) where
+
+foreign import data INFINITY :: Effect

src/Control/Monad/IOSync.purs

@@ -0,0 +1,63 @@
+module Control.Monad.IOSync
+  ( module Control.Monad.IO.Effect
+  , IOSync(..)
+  , runIOSync
+  , runIOSync'
+  ) where
+
+import Control.Alt (class Alt)
+import Control.Alternative (class Alternative)
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Class (class MonadEff, liftEff)
+import Control.Monad.Eff.Exception (Error, catchException, error, throwException)
+import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
+import Control.Monad.Error.Class (class MonadError, catchError, throwError)
+import Control.Monad.IO.Effect (INFINITY)
+import Control.Monad.Rec.Class (class MonadRec)
+import Control.MonadZero (class MonadZero)
+import Control.Plus (class Plus)
+import Data.Monoid (class Monoid, mempty)
+import Data.Newtype (class Newtype, unwrap, wrap)
+import Prelude
+
+newtype IOSync a = IOSync (Eff (infinity :: INFINITY) a)
+
+runIOSync :: IOSync ~> Eff (infinity :: INFINITY)
+runIOSync = unwrap
+
+runIOSync' :: ∀ eff. IOSync ~> Eff (infinity :: INFINITY | eff)
+runIOSync' = unsafeCoerceEff <<< unwrap
+
+derive instance newtypeIOSync :: Newtype (IOSync a) _
+
+derive newtype instance functorIOSync     :: Functor     IOSync
+derive newtype instance applyIOSync       :: Apply       IOSync
+derive newtype instance applicativeIOSync :: Applicative IOSync
+derive newtype instance bindIOSync        :: Bind        IOSync
+derive newtype instance monadIOSync       :: Monad       IOSync
+
+derive newtype instance monadRecIOSync :: MonadRec IOSync
+
+instance semigroupIOSync :: (Semigroup a) => Semigroup (IOSync a) where
+  append a b = append <$> a <*> b
+
+instance monoidIOSync :: (Monoid a) => Monoid (IOSync a) where
+  mempty = pure mempty
+
+instance monadEffIOSync :: MonadEff eff IOSync where
+  liftEff = wrap <<< unsafeCoerceEff
+
+instance monadErrorIOSync :: MonadError Error IOSync where
+  catchError a k = liftEff $
+    catchException (\e -> unwrap $ k e) (unsafeCoerceEff $ unwrap a)
+  throwError = liftEff <<< throwException
+
+instance altIOSync :: Alt IOSync where
+  alt a b = a `catchError` const b
+
+instance plusIOSync :: Plus IOSync where
+  empty = throwError $ error "plusIOSync.empty"
+
+instance alternativeIOSync :: Alternative IOSync
+
+instance monadZeroIOSync :: MonadZero IOSync

src/Control/Monad/IOSync/Class.purs

@@ -0,0 +1,16 @@
+module Control.Monad.IOSync.Class where
+
+import Control.Monad.Eff.Class (liftEff)
+import Control.Monad.IO (IO)
+import Control.Monad.IOSync (IOSync)
+import Data.Newtype (unwrap, wrap)
+import Prelude
+
+class (Monad m) <= MonadIOSync m where
+  liftIOSync :: IOSync ~> m
+
+instance monadIOSyncIOSync :: MonadIOSync IOSync where
+  liftIOSync = id
+
+instance monadIOSyncIO :: MonadIOSync IO where
+  liftIOSync = wrap <<< liftEff <<< unwrap