Skip to content

Instantly share code, notes, and snippets.

@joseanpg
Last active February 12, 2016 18:03
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save joseanpg/bf09ebed047fd59c3ac9 to your computer and use it in GitHub Desktop.
Save joseanpg/bf09ebed047fd59c3ac9 to your computer and use it in GitHub Desktop.
PureScript: Determinando el js-tipo de Aff a Aff a = (a -> (), Error-> ()) -> Canceler )
https://github.com/slamdata/purescript-aff/blob/master/src/Control/Monad/Aff.purs
-- | A canceler is asynchronous function that can be used to attempt the
-- | cancelation of a computation. Returns a boolean flag indicating whether
-- | or not the cancellation was successful. Many computations may be composite,
-- | in such cases the flag indicates whether any part of the computation was
-- | successfully canceled. The flag should not be used for communication.
newtype Canceler e = Canceler (Error -> Aff e Boolean)
-- | An asynchronous computation with effects `e`. The computation either
-- | errors or produces a value of type `a`.
-- |
-- | This is moral equivalent of `ErrorT (ContT Unit (Eff e)) a`.
foreign import data Aff :: # ! -> * -> *
-- | Creates an asynchronous effect from a function that accepts error and
-- | success callbacks. This function can be used for asynchronous computations
-- | that cannot be canceled.
makeAff :: forall e a. ((Error -> Eff e Unit) -> (a -> Eff e Unit) -> Eff e Unit) -> Aff e a
makeAff h = makeAff' (\e a -> const nonCanceler <$> h e a)
-- | Creates an asynchronous effect from a function that accepts error and
-- | success callbacks, and returns a canceler for the computation. This
-- | function can be used for asynchronous computations that can be canceled.
makeAff' :: forall e a. ((Error -> Eff e Unit) -> (a -> Eff e Unit) -> Eff e (Canceler e)) -> Aff e a
makeAff' h = _makeAff h
https://github.com/slamdata/purescript-aff/blob/master/src/Control/Monad/Aff.js
exports._makeAff = function (cb) {
return function(success, error) {
return cb(function(e) {
return function() {
error(e);
};
})(function(v) {
return function() {
try {
success(v);
} catch (e) {
error(e);
}
};
})();
}
}
typefun Eff a = () -> a
_makeAff cb = \(fs,fe)-> cb (\e-> \-> fe e) (\v-> \-> fs v) ()
e :: α
v :: β
fe e :: γ
fe :: α -> γ
\-> fe e :: () -> γ
:: Eff γ
\e-> \-> fe e :: α -> Eff γ
fs v :: δ
fs :: β -> δ
\-> fs v :: () -> δ
:: Eff δ
\v-> \-> fs v :: β -> Eff δ
cb (\e-> \-> fe e) (\v-> \-> fs v) () :: ε
cb :: (α -> Eff γ) -> ( β -> Eff δ) -> () -> ε
:: (α -> Eff γ) -> ( β -> Eff δ) -> Eff ε
\(fs,fe)-> cb (\e-> \-> fe e) (\v-> \-> fs v) () :: (β -> δ, α -> γ) -> ε
_makeAff cb :: (β -> δ, α -> γ) -> ε
_makeAff :: ((α -> Eff γ) -> (β -> Eff δ) -> Eff ε) -> (β -> δ, α -> γ) -> ε
From https://github.com/slamdata/purescript-aff/blob/master/src/Control/Monad/Aff.purs
_makeAff ::((Error -> Eff ()) -> (a -> Eff ()) -> Eff Canceler) -> Aff a
Then
α -> Eff γ = Error -> Eff ()
α = Error
γ = ()
β -> Eff δ = a -> Eff ()
β = a
δ = ()
Eff ε = Eff Canceler
ε = Canceler
(β -> δ, α -> γ) -> ε = Aff a
Aff a = (a -> (), Error-> ()) -> Canceler
https://github.com/slamdata/purescript-aff/blob/master/src/Control/Monad/Aff.purs
-- | Runs the asynchronous computation. You must supply an error callback and a
-- | success callback.
runAff :: forall e a. (Error -> Eff e Unit) -> (a -> Eff e Unit) -> Aff e a -> Eff e Unit
runAff ex f aff = runFn3 _runAff ex f aff
foreign import _runAff :: forall e a. Fn3 (Error -> Eff e Unit) (a -> Eff e Unit) (Aff e a) (Eff e Unit)
https://github.com/slamdata/purescript-aff/blob/master/src/Control/Monad/Aff.js
exports._runAff = function (errorT, successT, aff) {
return function() {
return aff(function(v) {
try {
successT(v)();
} catch (e) {
errorT(e)();
}
}, function(e) {
errorT(e)();
});
};
_runAff fe fs aff = \-> aff (\v-> fs v () , \e-> fe e ())
_runAff fe fs aff = \-> aff ( unpaf fs , unpaf fe )
e :: α
v :: β
fe e () :: γ
fe :: α -> () -> γ
\e-> fe e () :: α -> γ
fs v () :: δ
fs :: β -> () -> δ
\v-> fs v () :: β -> δ
aff (\v-> fs v () , \e-> fe e ()) :: ε
aff :: (β -> δ, α -> γ) -> ε
\-> aff (\v-> fs v () , \e-> fe e ()) :: () -> ε
_runAff fe fs aff :: () -> ε
_runAff :: (α -> () -> γ) -> (β -> () -> δ) -> ((β -> δ, α -> γ) -> ε) -> () -> ε
:: (α -> Eff γ) -> (β -> Eff δ) -> ((β -> δ, α -> γ) -> ε) -> Eff ε
From https://github.com/slamdata/purescript-aff/blob/master/src/Control/Monad/Aff.purs
runAff_ :: (Error -> Eff ()) -> (a -> Eff ()) -> Aff a -> Eff ()
Then
α -> Eff γ = Error -> Eff ()
α = Error
γ = ()
β -> Eff δ = a -> Eff ()
β = a
δ = ()
((β -> δ, α -> γ) -> ε) -> Eff ε = Aff a -> Eff ()
(β -> δ, α -> γ) -> ε = Aff a
Using Aff a = (a -> (), Error-> ()) -> Canceler
(β -> δ, α -> γ) -> ε = (a -> (), Error-> ()) -> Canceler
β = a
δ = ()
γ = ()
ε = Canceler
Eff ε = Eff ()
ε = ()
En estos momentos observo una contradicción:
ε = Canceler
ε = ()
A la espera de contestación de https://twitter.com/joseanpg/status/647740155571380225
-- | A constant canceller that always returns false.
nonCanceler :: forall e. Canceler e
nonCanceler = Canceler (const (pure false))
instance applicativeAff :: Applicative (Aff e) where
pure v = runFn2 _pure nonCanceler v
-- | A constant canceller that always returns true.
alwaysCanceler :: forall e. Canceler e
alwaysCanceler = Canceler (const (pure true))
instance bindAff :: Bind (Aff e) where
bind fa f = runFn3 _bind alwaysCanceler fa f
foreign import _bind :: forall e a b. Fn3 (Canceler e) (Aff e a) (a -> Aff e b) (Aff e b)
exports._bind = function (alwaysCanceler, aff, f) {
return function(success, error) {
var canceler1, canceler2;
var isCanceled = false;
var requestCancel = false;
var onCanceler = function(){};
canceler1 = aff(function(v) {
if (requestCancel) {
isCanceled = true;
return alwaysCanceler;
} else {
canceler2 = f(v)(success, error);
onCanceler(canceler2);
return canceler2;
}
}, error);
return function(e) {
return function(s, f) {
requestCancel = true;
if (canceler2 !== undefined) {
return canceler2(e)(s, f);
} else {
return canceler1(e)(function(bool) {
if (bool || isCanceled) {
try {
s(true);
} catch (e) {
f(e);
}
} else {
onCanceler = function(canceler) {
canceler(e)(s, f);
};
}
}, f));
}
};
};
};
}
bind aff f = \(fs, fe)-> aff (\v-> f v (fs, fe), fe)
[v] meta type variable for type of v
f v (fs,fe) :: alpha
f :: [v] -> ([fs],[fe]) -> alpha
\v-> f v (fs, fe) :: [v] -> alpha
aff (\v-> f v (fs, fe), fe) :: beta
aff :: ([v] -> alpha, [fe]) -> beta
\(fs, fe)-> aff (\v-> f v (fs, fe), fe) :: ([fs],[fe])-> beta
bind aff f :: Aff a
([fs],[fe])-> beta = Aff a = (a->(),Error->()->Canceller
unpaf :: (a -> () -> b) -> (a -> b)
unpaf f = \x-> f x ()
f x () = (unpaf f) x
paf :: (a -> b) -> (a -> () -> b)
paf g = \x->\-> g x
(paf g) x () = g x
--------------------------------------------------
typefun Eff a = () -> a
run :: Eff a -> a
run f = f ()
--------------------------------------------------
unpaf :: (a -> Eff b) -> (a -> b)
unpaf f = \x-> run (f x)
run (f x) = (unpaf f) x
paf :: (a -> b) -> (a -> Eff b)
paf g = \x->\-> g x
run ((paf g) x) = g x
--------------------------------------------
https://github.com/slamdata/purescript-aff
doNativeRequest :: Request -> (Response -> ())-> ()
\-> donative request f :: Eff ()
ajaxGet :: Eff a -> Request -> Eff ()
ajaxGet = \callback-> \request-> \-> doNativeRequest request ( unpaf callback )
ajaxGet' :: Request -> Aff Response
ajaxGet' req = makeAff (\onerror onsuccess -> ajaxGet onsuccess req)
ajaxGet' req >>= \response-> liftEff $ log response.body
class (Monad m) <= MonadEff eff m where
liftEff :: forall a. Eff eff a -> m a
instance monadEffEff :: MonadEff eff (Eff eff) where
liftEff = id
alias EffFun effs a b = (a -> b) with effs
alias EffPro effs b = (Unit -> b) with effs
alis EffCon effs a = (a -> Unit) with effs
EffPro ~ PureScript Eff
alias Aff effs ef1 ef2 ef3 a = (a -> () with ef1, Error -> () with ef2) -> Canceler with ef3
= (EffCon ef1 a , EffCon ef2 Error) -> Canceler with ef3
alias Canceler ef1 ef2 ef3 = Error -> ((EffCon ef1 Boolean , EffCon ef2 Error) -> Canceler with ef3)
newtype Canceler e = Canceler (Error -> Aff e Boolean)
m >>= f = λα.λβ. let α' = λx. f x α β
in aff α' β
type XMLHttpRequest
with open
setSuccessHandler
setErrorHandler
abort
makeRequest url α β =
xhr = XMLHttpRequest
xhr.setSuccessHandler α
xhr.setErrorHandler β
xhr.open url
return λx. xhr.abort x
-- | Forks the specified asynchronous computation so subsequent computations
-- | will not block on the result of the computation.
-- |
-- | Returns a canceler that can be used to attempt cancellation of the
-- | forked computation
forkAff :: forall e a. Aff e a -> Aff e (Canceler e)
forkAff aff = runFn2 _forkAff nonCanceler aff
foreign import _forkAff :: forall e a. Fn2 (Canceler e) (Aff e a) (Aff e (Canceler e))
exports._forkAff = function (nonCanceler, aff) {
var voidF = function(){};
return function(success, error) {
var canceler = aff(voidF, voidF);
try {
success(canceler);
} catch (e) {
error(e);
}
return nonCanceler;
};
}
_forkAff = \->nonCanceler \->aff
let voidF = \->();
in \(success, error)->
var canceler = aff (voidF, voidF)
try success canceler
catch (e) error(e)
return nonCanceler
aff >>= f =
λα.λβ. let α' = λx. f x α β
in aff α' β
-- 1. aff >>= f creado
-- 2. aff >>= f cargado
-- 3. aff >>= f a la espera
-- 4. aff >>= recibe señal
-- 5. se crea y se carga el diferido f x α β
-- 6. f x α β a la espera
-- Cancelación antes de 5, usamos el resultado de aff α' β
-- Canceluación después de 5? Necesitamos saber que se ha cargado
aff >>= f =
λα.λβ. let α' = λx. f x α β
canceler1 = aff α' β
aff >>= f =
λα.λβ. mutable canceler2 <- ()
let α' = λx. do canceler2 <- f x α β
return ()
canceler1 = aff α' β
in canceler1
-- Si canceler2 no está indefinido es que canceler1 está
-- ya fuera de combate y deberiamos usar maybe_canceler2
aff >>= f =
λα.λβ. mutable maybe_canceler2 <- Nothing
let α' = λx. do maybe_canceler2 <- Just (f x α β)
return ()
canceler1 = aff α' β
in λe. case maybe_canceller2 of
Nothing -> canceler1 e
Just canceler2 -> canceler2 e
---------------------------------------------------------------------
aff >>= f =
λα.λβ. do let isCanceled = false
requestCancel = false
α' = λx. if requestCancel
then do isCanceled = true
return alwaysCanceler
else canceler2 = f x α β
onCanceler canceler2
return canceler2
canceler1 = aff α' β
return λe.λα''.λβ''. do requestCancel <- true;
if canceler2 !== undefined
then return canceler2 e α'' β''
else return canceler1 e (λb. if b or isCanceled
then try α'' True
catch e -> β'' e
else onCanceler = λ canceler. canceler e α'' β'')
β''
exports._bind = function (alwaysCanceler, aff, f) {
return function(success, error) {
var canceler1, canceler2;
var isCanceled = false;
var requestCancel = false;
var onCanceler = function(){};
canceler1 = aff(function(v) {
if (requestCancel) {
isCanceled = true;
return alwaysCanceler;
} else {
canceler2 = f(v)(success, error);
onCanceler(canceler2);
return canceler2;
}
}, error);
return function(e) {
return function(s, f) {
requestCancel = true;
if (canceler2 !== undefined) {
return canceler2(e)(s, f);
} else {
return canceler1(e)(function(bool) {
if (bool || isCanceled) {
try {
s(true);
} catch (e) {
f(e);
}
} else {
onCanceler = function(canceler) {
canceler(e)(s, f);
};
}
}, f));
}
};
};
};
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment