Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Started to refactor Cont #71

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.

Sign up for GitHub

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

Open
DanielGronau wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Started to refactor Cont #71

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
207 changes: 59 additions & 148 deletions src/main/java/org/highj/data/continuations/Cont.java
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,180 +1,91 @@
package org.highj.data.continuations;

import org.derive4j.hkt.__;
import org.derive4j.hkt.__2;
import org.highj.data.continuations.cont.ContApplicative;
import org.highj.data.continuations.cont.ContFunctor;
import org.highj.data.continuations.cont.ContMonad;
import org.highj.function.Functions;

import java.util.function.Function;

public class Cont<R, A> implements __2<Cont.µ, R, A> {
/**
* The monad for delimited continuations.
* @param <R> the result type
* @param <A> the input type
*/
public class Cont<R, A> implements __2<Cont.µ, R, A>, Function<Function<A, R>, R> {

private Function<Function<A,R>,R> fn;
public interface µ {
}

public static class µ {}
private Function<Function<A, R>, R> fn;

public Cont(Function<Function<A,R>,R> fn) {
public Cont(Function<Function<A, R>, R> fn) {
this.fn = fn;
}

public Function<Function<A,R>,R> runCont() {
return fn;
@Override
public R apply(Function<A, R> input) {
return fn.apply(input);
}

public Cont<R,A> mapCont(Function<R,R> transform) {
return new Cont<>(Functions.compose(transform,fn));
public Function<Function<A, R>, R> runCont() {
return fn;
}

public <B> Cont<R,B> withCont(Function<Function<B,R>,Function<A,R>> transform) {
return new Cont<>(Functions.compose(fn,transform));
public Cont<R, A> mapCont(Function<R, R> transform) {
return new Cont<>(fn.andThen(transform));
}

public static <S> ContMonad<S> monad() {
return new ContMonad<S>(){};
public <B> Cont<R, B> map(Function<A,B> fn) {
return new Cont<>(b -> this.apply(a -> b.apply(fn.apply(a))));
}

}


/*

instance Functor (Cont r) where
fmap f m = Cont $ \c -> runCont m (c . f)

instance Monad (Cont r) where
return a = Cont ($ a)
m >>= k = Cont $ \c -> runCont m $ \a -> runCont (k a) c

instance MonadCont (Cont r) where
callCC f = Cont $ \c -> runCont (f (\a -> Cont $ \__ -> c a)) c

{- |
The continuation monadTrans transformer.
Can be used to add continuation handling to other monads.
-}
newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }

mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a
mapContT f m = ContT $ f . runContT m

withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
withContT f m = ContT $ runContT m . f

instance (Monad m) => Functor (ContT r m) where
fmap f m = ContT $ \c -> runContT m (c . f)

instance (Monad m) => Monad (ContT r m) where
return a = ContT ($ a)
m >>= k = ContT $ \c -> runContT m (\a -> runContT (k a) c)

instance (Monad m) => MonadCont (ContT r m) where
callCC f = ContT $ \c -> runContT (f (\a -> ContT $ \__ -> c a)) c

-- ---------------------------------------------------------------------------
-- Instances for other mtl transformers

instance MonadTrans (ContT r) where
lift m = ContT (m >>=)

instance (MonadIO m) => MonadIO (ContT r m) where
liftIO = lift . liftIO
public <B> Cont<R,B> ap(Cont<R, Function<A,B>> fnCont) {
return new Cont<>(c -> fnCont.apply(g -> this.apply(g.andThen(c))));
}

-- Needs -fallow-undecidable-instances
instance (MonadReader r' m) => MonadReader r' (ContT r m) where
ask = lift ask
local f m = ContT $ \c -> do
r <- ask
local f (runContT m (local (const r) . c))
public <B> Cont<R,B> bind(Function<A, Cont<R,B>> fn) {
return new Cont<>(c -> this.apply(b -> fn.apply(b).apply(c)));
}

-- Needs -fallow-undecidable-instances
instance (MonadState s m) => MonadState s (ContT r m) where
get = lift get
put = lift . put
public <B> Cont<R, B> with(Function<Function<B, R>, Function<A, R>> transform) {
return new Cont<>(transform.andThen(fn));
}

{- $simpleContExample
Calculating length of a list continuation-style:
public static <R,A> Cont<R,A> pure(A a) {
return new Cont<>(fn -> fn.apply(a));
}

>calculateLength :: [a] -> Cont r Int
>calculateLength l = return (length l)
public static <R> R eval(Cont<R, R> cont) {
return cont.apply(Function.identity());
}

Here we use @calculateLength@ by making it to pass its result to @print@:
public static <R, R_> Cont<R_, R> reset(Cont<R, R> cont) {
return new Cont<>(k -> k.apply(eval(cont)));
}

>main = do
> runCont (calculateLength "123") print
> -- result: 3
public static <A, S, R> Cont<R, A> shift(Function<Function<A, Cont<S, R>>, Cont<R, R>> fn) {
return new Cont<>(k -> eval(fn.apply(k.andThen(Cont::pure))));
}

It is possible to chain 'Cont' blocks with @>>=@.
public static <A,B,R> Cont<R,A> callCC(Function<Function<A, Cont<R,B>>, Cont<R,A>> fn) {
return new Cont<>(c -> fn.apply(x ->
new Cont<>(Functions.constant(c.apply(x)))).apply(c));
}

>double :: Int -> Cont r Int
>double n = return (n * 2)
>
>main = do
> runCont (calculateLength "123" >>= double) print
> -- result: 6
-}
public static <S> ContFunctor<S> functor() {
return new ContFunctor<S>() {
};
}

{- $callCCExample
This example gives a taste of how escape continuations work, shows a typical
pattern for their usage.
public static <S> ContApplicative<S> applicative() {
return new ContApplicative<S>() {
};
}

>-- Returns a string depending on the length of the name parameter.
>-- If the provided string is empty, returns an error.
>-- Otherwise, returns a welcome message.
>whatsYourName :: String -> String
>whatsYourName name =
> (`runCont` id) $ do -- 1
> response <- callCC $ \exit -> do -- 2
> validateName name exit -- 3
> return $ "Welcome, " ++ name ++ "!" -- 4
> return response -- 5
>
>validateName name exit = do
> when (null name) (exit "You forgot to tell me your name!")

Here is what this example does:

(1) Runs an anonymous 'Cont' block and extracts value from it with
@(\`runCont\` id)@. Here @id@ is the continuation, passed to the @Cont@ block.

(1) Binds @response@ to the result of the following 'callCC' block,
binds @exit@ to the continuation.

(1) Validates @name@.
This approach illustrates advantage of using 'callCC' over @return@.
We pass the continuation to @validateName@,
and interrupt execution of the @Cont@ block from /inside/ of @validateName@.

(1) Returns the welcome message from the @callCC@ block.
This line is not executed if @validateName@ fails.

(1) Returns from the @Cont@ block.
-}

{-$ContTExample
'ContT' can be used to add continuation handling to other monads.
Here is an example how to combine it with @IO@ monadTrans:

>import Control.Monad.Cont
>import System.IO
>
>main = do
> hSetBuffering stdout NoBuffering
> runContT (callCC askString) reportResult
>
>askString :: (String -> ContT () IO String) -> ContT () IO String
>askString next = do
> liftIO $ putStrLn "Please enter a string"
> s <- liftIO $ getLine
> next s
>
>reportResult :: String -> IO ()
>reportResult s = do
> putStrLn ("You entered: " ++ s)

Action @askString@ requests user to enter a string,
and passes it to the continuation.
@askString@ takes as a parameter a continuation taking a string parameter,
and returning @IO ()@.
Compare its signature to 'runContT' definition.
-}
* */
public static <S> ContMonad<S> monad() {
return new ContMonad<S>() {
};
}
}
22 changes: 22 additions & 0 deletions src/main/java/org/highj/data/continuations/cont/ContApplicative.java
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,22 @@
package org.highj.data.continuations.cont;

import org.derive4j.hkt.__;
import org.highj.data.continuations.Cont;
import org.highj.typeclass1.monad.Applicative;

import java.util.function.Function;

import static org.highj.Hkt.asCont;

public interface ContApplicative<S> extends ContFunctor<S>, Applicative<__<Cont.µ, S>> {

@Override
default <A> Cont<S, A> pure(A a) {
return Cont.pure(a);
}

@Override
default <A, B> Cont<S, B> ap(__<__<Cont.µ, S>, Function<A, B>> fn, __<__<Cont.µ, S>, A> nestedA) {
return asCont(nestedA).ap(asCont(fn));
}
}
17 changes: 17 additions & 0 deletions src/main/java/org/highj/data/continuations/cont/ContFunctor.java
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
package org.highj.data.continuations.cont;

import org.derive4j.hkt.__;
import org.highj.data.continuations.Cont;
import org.highj.typeclass1.functor.Functor;

import java.util.function.Function;

import static org.highj.Hkt.asCont;

public interface ContFunctor<S> extends Functor<__<Cont.µ, S>> {

@Override
default <A, B> Cont<S, B> map(Function<A, B> fn, __<__<Cont.µ, S>, A> nestedA) {
return asCont(asCont(nestedA).map(fn));
}
}
27 changes: 3 additions & 24 deletions src/main/java/org/highj/data/continuations/cont/ContMonad.java
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,30 +14,9 @@
* @author Daniel Gronau
* @author Clinton Selke
*/
public class ContMonad<S> implements Monad<__<µ, S>> {
public interface ContMonad<S> extends ContApplicative<S>, Monad<__<µ, S>> {
@Override
public <A> Cont<S, A> pure(A a) {
return new Cont<>(Functions.<A,S>flipApply().apply(a));
}

@Override
public <A, B> Cont<S, B> ap(__<__<µ, S>, Function<A, B>> fn, __<__<µ, S>, A> nestedA) {
return bind(fn, (Function<A, B> fn2) -> map(fn2, nestedA));
}

@Override
public <A, B> Cont<S, B> bind(__<__<µ, S>, A> nestedA, Function<A, __<__<µ, S>, B>> fn) {
//m >>= k = Cont $ \c -> runCont m $ \a -> runCont (k a) c
Function<Function<A,S>,S> fa = asCont(nestedA).runCont();
Function<Function<B,S>,S> fb = c -> fa.apply(b -> asCont(fn.apply(b)).runCont().apply(c));
return new Cont<>(fb);
}

@Override
public <A, B> Cont<S, B> map(Function<A, B> fn, __<__<µ, S>, A> nestedA) {
// fmap f m = Cont $ \c -> runCont m (c . f)
Function<Function<A,S>,S> fa = asCont(nestedA).runCont();
Function<Function<B,S>,S> fb = c -> fa.apply(x -> c.apply(fn.apply(x)));
return new Cont<>(fb);
default <A, B> Cont<S, B> bind(__<__<µ, S>, A> nestedA, Function<A, __<__<µ, S>, B>> fn) {
return asCont(nestedA).bind(a -> asCont(fn.apply(a)));
}
}
44 changes: 44 additions & 0 deletions src/test/java/org/highj/data/continuations/ContTest.java
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,44 @@
package org.highj.data.continuations;

import org.junit.Test;

import static org.assertj.core.api.Assertions.assertThat;

public class ContTest {
@Test
public void map() throws Exception {
}

@Test
public void with() throws Exception {
}

@Test
public void eval() throws Exception {
}

@Test
public void resetShift() throws Exception {
Cont<Integer, Integer> s = Cont.<Integer, Integer, Integer>shift(
fn -> fn.apply(3).bind(fn).bind(fn));
Cont<Integer, Integer> r = Cont.reset(s.map(x -> x * 2));
assertThat(Cont.eval(r)).isEqualTo(24);
}

@Test
public void callCC() throws Exception {
}

@Test
public void functor() throws Exception {
}

@Test
public void applicative() throws Exception {
}

@Test
public void monad() throws Exception {
}

}