diff --git a/README.md b/README.md index 9e78d5f..759227f 100644 --- a/README.md +++ b/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! diff --git a/bower.json b/bower.json index 5006e68..7ae5ef6 100644 --- a/bower.json +++ b/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" } } diff --git a/src/Control/Monad/IO.purs b/src/Control/Monad/IO.purs index 3a619ed..8bc3a15 100644 --- a/src/Control/Monad/IO.purs +++ b/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 diff --git a/src/Control/Monad/IO/Class.purs b/src/Control/Monad/IO/Class.purs index 0156fe1..9d636d1 100644 --- a/src/Control/Monad/IO/Class.purs +++ b/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 diff --git a/src/Control/Monad/IO/Effect.purs b/src/Control/Monad/IO/Effect.purs new file mode 100644 index 0000000..67fe6c9 --- /dev/null +++ b/src/Control/Monad/IO/Effect.purs @@ -0,0 +1,5 @@ +module Control.Monad.IO.Effect + ( INFINITY + ) where + +foreign import data INFINITY :: Effect diff --git a/src/Control/Monad/IOSync.purs b/src/Control/Monad/IOSync.purs new file mode 100644 index 0000000..7d12fd5 --- /dev/null +++ b/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 diff --git a/src/Control/Monad/IOSync/Class.purs b/src/Control/Monad/IOSync/Class.purs new file mode 100644 index 0000000..c55bf6a --- /dev/null +++ b/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