1
Fork 0

purescript(reverse-state): feat: failed to use run

Signed-off-by: prescientmoon <git@moonythm.dev>
This commit is contained in:
Matei Adriel 2020-11-16 13:26:43 +02:00 committed by prescientmoon
commit eb66415103
Signed by: prescientmoon
SSH key fingerprint: SHA256:WFp/cO76nbarETAoQcQXuV+0h7XJsEsOCI0UsyPIy6U
6 changed files with 296 additions and 0 deletions

10
purescript/reverse-state/.gitignore vendored Normal file
View file

@ -0,0 +1,10 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc-package/
/.psc*
/.purs*
/.psa*
/.spago

View 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

View 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" ]
}

View 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

View file

@ -0,0 +1,10 @@
module Main where
import Prelude
import Effect (Effect)
import Effect.Console (log)
main :: Effect Unit
main = do
log "🍝"

View 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."