Skip to content

Compiler/0.12 #15

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
May 24, 2018
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
16 changes: 9 additions & 7 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -12,16 +12,18 @@
"license": "MIT",
"repository": {
"type": "git",
"url": "git://github.com/paf31/purescript-freet.git"
"url": "git://github.com/purescript-contrib/purescript-freet.git"
},
"dependencies": {
"purescript-control": "^3.0.0",
"purescript-tailrec": "^3.0.0",
"purescript-transformers": "^3.0.0",
"purescript-exists": "^3.0.0",
"purescript-eff": "^3.0.0"
"purescript-bifunctors": "^4.0.0",
"purescript-effect": "^2.0.0",
"purescript-either": "^4.0.0",
"purescript-exists": "^4.0.0",
"purescript-prelude": "^4.0.0",
"purescript-tailrec": "^4.0.0",
"purescript-transformers": "^4.0.0"
},
"devDependencies": {
"purescript-console": "^3.0.0"
"purescript-console": "^4.0.0"
}
}
11 changes: 5 additions & 6 deletions src/Control/Monad/Free/Trans.purs
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ module Control.Monad.Free.Trans
import Prelude

import Control.Apply (lift2)
import Control.Monad.Eff.Class (class MonadEff, liftEff)
import Control.Monad.Error.Class (class MonadThrow, throwError)
import Control.Monad.Reader.Class (class MonadAsk, ask)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
Expand All @@ -24,7 +23,7 @@ import Control.Monad.Writer.Class (class MonadTell, tell)
import Data.Bifunctor (bimap)
import Data.Either (Either(..))
import Data.Exists (Exists, mkExists, runExists)
import Data.Monoid (class Monoid, mempty)
import Effect.Class (class MonadEffect, liftEffect)

-- | Instead of implementing `bind` directly, we capture the bind using this data structure, to
-- | evaluate later.
Expand Down Expand Up @@ -88,8 +87,8 @@ instance semigroupFreeT :: (Functor f, Monad m, Semigroup w) => Semigroup (FreeT
instance monoidFreeT :: (Functor f, Monad m, Monoid w) => Monoid (FreeT f m w) where
mempty = pure mempty

instance monadEffFreeT :: (Functor f, MonadEff eff m) => MonadEff eff (FreeT f m) where
liftEff = lift <<< liftEff
instance monadEffectFreeT :: (Functor f, MonadEffect m) => MonadEffect (FreeT f m) where
liftEffect = lift <<< liftEffect

instance monadAskFreeT :: (Functor f, MonadAsk r m) => MonadAsk r (FreeT f m) where
ask = lift ask
Expand All @@ -109,11 +108,11 @@ liftFreeT fa = FreeT \_ -> pure (Right (map pure fa))

-- | Change the underlying `Monad` for a `FreeT` action.
hoistFreeT :: forall f m n a. Functor f => Functor n => (m ~> n) -> FreeT f m a -> FreeT f n a
hoistFreeT = bimapFreeT id
hoistFreeT = bimapFreeT identity

-- | Change the base functor `f` for a `FreeT` action.
interpret :: forall f g m a. Functor f => Functor m => (f ~> g) -> FreeT f m a -> FreeT g m a
interpret nf = bimapFreeT nf id
interpret nf = bimapFreeT nf identity

-- | Change the base functor `f` and the underlying `Monad` for a `FreeT` action.
bimapFreeT :: forall f g m n a. Functor f => Functor n => (f ~> g) -> (m ~> n) -> FreeT f m a -> FreeT g n a
Expand Down
14 changes: 7 additions & 7 deletions test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,9 @@ module Test.Main where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Control.Monad.Free.Trans (FreeT, runFreeT, liftFreeT)
import Control.Monad.Rec.Class (forever)
import Control.Monad.Trans.Class (lift)
Expand All @@ -23,18 +23,18 @@ writeLine :: forall m. Monad m => String -> FreeT TeletypeF m Unit
writeLine s = liftFreeT (WriteLine s unit)

readLine :: forall m. Monad m => FreeT TeletypeF m String
readLine = liftFreeT (ReadLine id)
readLine = liftFreeT (ReadLine identity)

mockTeletype :: forall a eff. Teletype (Eff (console :: CONSOLE | eff)) a -> Eff (console :: CONSOLE | eff) a
mockTeletype :: forall a. Teletype Effect a -> Effect a
mockTeletype = runFreeT interp
where
interp (WriteLine s next) = do
liftEff (log s)
liftEffect (log s)
pure next
interp (ReadLine k) = do
pure (k "Fake input")

main :: forall eff. Eff (console :: CONSOLE | eff) Unit
main :: Effect Unit
main = mockTeletype $ forever do
lift $ log "Enter some input:"
s <- readLine
Expand Down