commit eb6641510340ec1407773b64eb3aa6d016428e62 Author: Matei Adriel Date: Mon Nov 16 13:26:43 2020 +0200 purescript(reverse-state): feat: failed to use run Signed-off-by: prescientmoon diff --git a/purescript/reverse-state/.gitignore b/purescript/reverse-state/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/purescript/reverse-state/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/purescript/reverse-state/packages.dhall b/purescript/reverse-state/packages.dhall new file mode 100644 index 0000000..d21b708 --- /dev/null +++ b/purescript/reverse-state/packages.dhall @@ -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 diff --git a/purescript/reverse-state/spago.dhall b/purescript/reverse-state/spago.dhall new file mode 100644 index 0000000..a46c992 --- /dev/null +++ b/purescript/reverse-state/spago.dhall @@ -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" ] +} diff --git a/purescript/reverse-state/src/Fix.purs b/purescript/reverse-state/src/Fix.purs new file mode 100644 index 0000000..92e7b0f --- /dev/null +++ b/purescript/reverse-state/src/Fix.purs @@ -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 diff --git a/purescript/reverse-state/src/Main.purs b/purescript/reverse-state/src/Main.purs new file mode 100644 index 0000000..5c18dca --- /dev/null +++ b/purescript/reverse-state/src/Main.purs @@ -0,0 +1,10 @@ +module Main where + +import Prelude + +import Effect (Effect) +import Effect.Console (log) + +main :: Effect Unit +main = do + log "🍝" diff --git a/purescript/reverse-state/test/Main.purs b/purescript/reverse-state/test/Main.purs new file mode 100644 index 0000000..f91f98c --- /dev/null +++ b/purescript/reverse-state/test/Main.purs @@ -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."