purescript(reverse-state): feat: failed to use run
Signed-off-by: prescientmoon <git@moonythm.dev>
This commit is contained in:
commit
eb66415103
10
purescript/reverse-state/.gitignore
vendored
Normal file
10
purescript/reverse-state/.gitignore
vendored
Normal file
|
@ -0,0 +1,10 @@
|
|||
/bower_components/
|
||||
/node_modules/
|
||||
/.pulp-cache/
|
||||
/output/
|
||||
/generated-docs/
|
||||
/.psc-package/
|
||||
/.psc*
|
||||
/.purs*
|
||||
/.psa*
|
||||
/.spago
|
128
purescript/reverse-state/packages.dhall
Normal file
128
purescript/reverse-state/packages.dhall
Normal file
|
@ -0,0 +1,128 @@
|
|||
{-
|
||||
Welcome to your new Dhall package-set!
|
||||
|
||||
Below are instructions for how to edit this file for most use
|
||||
cases, so that you don't need to know Dhall to use it.
|
||||
|
||||
## Warning: Don't Move This Top-Level Comment!
|
||||
|
||||
Due to how `dhall format` currently works, this comment's
|
||||
instructions cannot appear near corresponding sections below
|
||||
because `dhall format` will delete the comment. However,
|
||||
it will not delete a top-level comment like this one.
|
||||
|
||||
## Use Cases
|
||||
|
||||
Most will want to do one or both of these options:
|
||||
1. Override/Patch a package's dependency
|
||||
2. Add a package not already in the default package set
|
||||
|
||||
This file will continue to work whether you use one or both options.
|
||||
Instructions for each option are explained below.
|
||||
|
||||
### Overriding/Patching a package
|
||||
|
||||
Purpose:
|
||||
- Change a package's dependency to a newer/older release than the
|
||||
default package set's release
|
||||
- Use your own modified version of some dependency that may
|
||||
include new API, changed API, removed API by
|
||||
using your custom git repo of the library rather than
|
||||
the package set's repo
|
||||
|
||||
Syntax:
|
||||
Replace the overrides' "{=}" (an empty record) with the following idea
|
||||
The "//" or "⫽" means "merge these two records and
|
||||
when they have the same value, use the one on the right:"
|
||||
-------------------------------
|
||||
let overrides =
|
||||
{ packageName =
|
||||
upstream.packageName // { updateEntity1 = "new value", updateEntity2 = "new value" }
|
||||
, packageName =
|
||||
upstream.packageName // { version = "v4.0.0" }
|
||||
, packageName =
|
||||
upstream.packageName // { repo = "https://www.example.com/path/to/new/repo.git" }
|
||||
}
|
||||
-------------------------------
|
||||
|
||||
Example:
|
||||
-------------------------------
|
||||
let overrides =
|
||||
{ halogen =
|
||||
upstream.halogen // { version = "master" }
|
||||
, halogen-vdom =
|
||||
upstream.halogen-vdom // { version = "v4.0.0" }
|
||||
}
|
||||
-------------------------------
|
||||
|
||||
### Additions
|
||||
|
||||
Purpose:
|
||||
- Add packages that aren't already included in the default package set
|
||||
|
||||
Syntax:
|
||||
Replace the additions' "{=}" (an empty record) with the following idea:
|
||||
-------------------------------
|
||||
let additions =
|
||||
{ package-name =
|
||||
{ dependencies =
|
||||
[ "dependency1"
|
||||
, "dependency2"
|
||||
]
|
||||
, repo =
|
||||
"https://example.com/path/to/git/repo.git"
|
||||
, version =
|
||||
"tag ('v4.0.0') or branch ('master')"
|
||||
}
|
||||
, package-name =
|
||||
{ dependencies =
|
||||
[ "dependency1"
|
||||
, "dependency2"
|
||||
]
|
||||
, repo =
|
||||
"https://example.com/path/to/git/repo.git"
|
||||
, version =
|
||||
"tag ('v4.0.0') or branch ('master')"
|
||||
}
|
||||
, etc.
|
||||
}
|
||||
-------------------------------
|
||||
|
||||
Example:
|
||||
-------------------------------
|
||||
let additions =
|
||||
{ benchotron =
|
||||
{ dependencies =
|
||||
[ "arrays"
|
||||
, "exists"
|
||||
, "profunctor"
|
||||
, "strings"
|
||||
, "quickcheck"
|
||||
, "lcg"
|
||||
, "transformers"
|
||||
, "foldable-traversable"
|
||||
, "exceptions"
|
||||
, "node-fs"
|
||||
, "node-buffer"
|
||||
, "node-readline"
|
||||
, "datetime"
|
||||
, "now"
|
||||
]
|
||||
, repo =
|
||||
"https://github.com/hdgarrood/purescript-benchotron.git"
|
||||
, version =
|
||||
"v7.0.0"
|
||||
}
|
||||
}
|
||||
-------------------------------
|
||||
-}
|
||||
|
||||
|
||||
let upstream =
|
||||
https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall sha256:55ebdbda1bd6ede4d5307fbc1ef19988c80271b4225d833c8d6fb9b6fb1aa6d8
|
||||
|
||||
let overrides = {=}
|
||||
|
||||
let additions = {=}
|
||||
|
||||
in upstream // overrides // additions
|
17
purescript/reverse-state/spago.dhall
Normal file
17
purescript/reverse-state/spago.dhall
Normal file
|
@ -0,0 +1,17 @@
|
|||
{-
|
||||
Welcome to a Spago project!
|
||||
You can edit this file as you like.
|
||||
-}
|
||||
{ name = "my-project"
|
||||
, dependencies =
|
||||
[ "console"
|
||||
, "effect"
|
||||
, "lazy"
|
||||
, "profunctor"
|
||||
, "psci-support"
|
||||
, "run"
|
||||
, "undefined"
|
||||
]
|
||||
, packages = ./packages.dhall
|
||||
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
|
||||
}
|
120
purescript/reverse-state/src/Fix.purs
Normal file
120
purescript/reverse-state/src/Fix.purs
Normal file
|
@ -0,0 +1,120 @@
|
|||
module Fix where
|
||||
|
||||
import Prelude
|
||||
import Control.Lazy (fix)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Lazy (defer)
|
||||
import Data.Lazy as Lazy
|
||||
import Data.Symbol (class IsSymbol)
|
||||
import Data.Traversable (sequence)
|
||||
import Data.Tuple (Tuple)
|
||||
import Prim.Row as Row
|
||||
import Run (FProxy, Run, SProxy(..), VariantF)
|
||||
import Run as Run
|
||||
import Undefined (undefined)
|
||||
|
||||
data BackwardsState s a
|
||||
= BackwardsState (s -> s) (s -> a)
|
||||
|
||||
derive instance functorBS ∷ Functor (BackwardsState s)
|
||||
|
||||
type BACKWARDS_STATE s
|
||||
= FProxy (BackwardsState s)
|
||||
|
||||
_backwardsState ∷ SProxy "backwardsState"
|
||||
_backwardsState = SProxy
|
||||
|
||||
liftBackwardsState ∷ forall s a r. BackwardsState s a → Run ( backwardsState ∷ BACKWARDS_STATE s | r ) a
|
||||
liftBackwardsState = liftBackwardsStateAt _backwardsState
|
||||
|
||||
liftBackwardsStateAt ∷
|
||||
forall t state a r label.
|
||||
IsSymbol label ⇒
|
||||
Row.Cons label (BACKWARDS_STATE state) t r ⇒
|
||||
SProxy label →
|
||||
BackwardsState state a →
|
||||
Run r a
|
||||
liftBackwardsStateAt = Run.lift
|
||||
|
||||
runBackwardsStateAt ::
|
||||
forall label state rowWithState row a.
|
||||
IsSymbol label ⇒
|
||||
Row.Cons label (BACKWARDS_STATE state) row rowWithState ⇒
|
||||
SProxy label →
|
||||
state →
|
||||
Run rowWithState a →
|
||||
Run row (Tuple state a)
|
||||
runBackwardsStateAt sym = undefined
|
||||
where
|
||||
handle ::
|
||||
forall b.
|
||||
VariantF rowWithState
|
||||
(Run rowWithState b) ->
|
||||
Either (BackwardsState state (Run rowWithState b)) (VariantF row (Run rowWithState b))
|
||||
handle = Run.on sym Left Right
|
||||
|
||||
mkLoop ::
|
||||
forall result acc b.
|
||||
( acc ->
|
||||
(BackwardsState state (Run rowWithState b)) ->
|
||||
Run row result
|
||||
) ->
|
||||
(acc -> b -> result) -> acc -> Run rowWithState b -> Run row result
|
||||
mkLoop handleState handleResult accumulated r = case Run.peel r of
|
||||
Left peeled → case handle peeled of
|
||||
Left bs → handleState accumulated bs
|
||||
Right a' → Run.send a' >>= mkLoop handleState handleResult accumulated
|
||||
Right result → pure $ handleResult accumulated result
|
||||
|
||||
loopState :: Lazy.Lazy state -> Run rowWithState Unit -> Run row (Lazy.Lazy state)
|
||||
loopState = mkLoop handleState handleResult
|
||||
where
|
||||
{-
|
||||
past = ...
|
||||
present <- mkState future
|
||||
future <- mkState past
|
||||
-}
|
||||
handleState :: state -> BackwardsState state (Run rowWithState Unit) -> Run row (Lazy.Lazy state)
|
||||
handleState state (BackwardsState mkState mkValue) =
|
||||
sequence do
|
||||
(futureState :: Run _ _) <-
|
||||
fix \m -> do
|
||||
(futureState :: Run _ _) <- m
|
||||
let
|
||||
value :: Run _ _
|
||||
value = mkValue <$> futureState
|
||||
|
||||
state' :: Run _ (Lazy.Lazy state)
|
||||
state' = value >>= loopState state
|
||||
pure
|
||||
state'
|
||||
pure (mkState <$> futureState)
|
||||
|
||||
handleResult = const
|
||||
|
||||
-- case Run.peel r of
|
||||
-- Left a → case handle a of
|
||||
-- Left (BackwardsState mkState _) → do
|
||||
-- resultState <- loopState state
|
||||
-- pure (mkState futureState)
|
||||
-- Right a' → b >>= f
|
||||
-- where
|
||||
-- f = runBackwardsStateAt sym s
|
||||
-- b = Run.send a'
|
||||
-- Right a → pure (Tuple s a)
|
||||
-- loop :: state -> Run rowWithState a -> Run row (Tuple state a)
|
||||
-- loop s r = case Run.peel r of
|
||||
-- Left a → case handle a of
|
||||
-- Left (BackwardsState mkState mkValue) → do
|
||||
-- let
|
||||
-- value = mkValue resultState
|
||||
-- (Tuple resultState resultValue) <- loop s value
|
||||
-- pure $ Tuple (mkState futureState) resultValue
|
||||
-- Right a' → b >>= f
|
||||
-- where
|
||||
-- f :: Run rowWithState a -> Run row (Tuple state a)
|
||||
-- f = runBackwardsStateAt sym s
|
||||
-- b :: Run row (Run rowWithState a)
|
||||
-- b = Run.send a'
|
||||
-- Right a → pure (Tuple s a)
|
||||
a = 3
|
10
purescript/reverse-state/src/Main.purs
Normal file
10
purescript/reverse-state/src/Main.purs
Normal file
|
@ -0,0 +1,10 @@
|
|||
module Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Effect (Effect)
|
||||
import Effect.Console (log)
|
||||
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
log "🍝"
|
11
purescript/reverse-state/test/Main.purs
Normal file
11
purescript/reverse-state/test/Main.purs
Normal file
|
@ -0,0 +1,11 @@
|
|||
module Test.Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Effect (Effect)
|
||||
import Effect.Class.Console (log)
|
||||
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
log "🍝"
|
||||
log "You should add some tests."
|
Loading…
Reference in a new issue