Add free

purescript/README.md

@@ -9,6 +9,7 @@
 | [ecs](./ecs/)                            | Purescript-wrapper for [thi.ng/ecs](thi.ng/ecs)                                                                      |
 | [existentials-blog](./existentials-blog) | Perhaps supposed to turn into a blog about existentials?                                                             |
 | [existentials](./existentials)           | Experiment regarding the Church-encoding of existential types                                                        |
+| [free](./free/)                          | Experiments regarding free monads and interpreting algebras                                                          |
 | [gadts](./gadts)                         | Experiment regarding ways to encode GADTs in Purescript                                                              |
 | [lambda-calculus](./lambda-calculus)     | Lambda calculus evaluator                                                                                            |
 | [lunarline](./lunarline)                 | Attempt at optimizing a functional language using compile-time partial evaluation                                    |

purescript/free/.gitignore

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

purescript/free/README.md

@@ -0,0 +1,11 @@
+# Free
+
+My experiments with free monads and interpreting algebras.
+
+## File structure
+
+| File                             | Description                                              |
+| -------------------------------- | -------------------------------------------------------- |
+| [Exists.purs](./src/Exists.purs) | Basic existential types                                  |
+| [Lambda.purs](./src/Lambda.purs) | Function call algebra and interpreter using existentials |
+| [Math.purs](./src/Math.purs)     | Addition & multiplication free monad and interpreter     |

purescript/free/packages.dhall

@@ -0,0 +1,110 @@
+{-
+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:
+where `entityName` is one of the following:
+- dependencies
+- repo
+- version
+-------------------------------
+let upstream = --
+in  upstream
+  with packageName.entityName = "new value"
+-------------------------------
+
+Example:
+-------------------------------
+let upstream = --
+in  upstream
+  with halogen.version = "master"
+  with halogen.repo = "https://example.com/path/to/git/repo.git"
+
+  with halogen-vdom.version = "v4.0.0"
+-------------------------------
+
+### Additions
+
+Purpose:
+- Add packages that aren't already included in the default package set
+
+Syntax:
+where `<version>` is:
+- a tag (i.e. "v4.0.0")
+- a branch (i.e. "master")
+- commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977")
+-------------------------------
+let upstream = --
+in  upstream
+  with new-package-name =
+    { dependencies =
+       [ "dependency1"
+       , "dependency2"
+       ]
+    , repo =
+       "https://example.com/path/to/git/repo.git"
+    , version =
+        "<version>"
+    }
+-------------------------------
+
+Example:
+-------------------------------
+let upstream = --
+in  upstream
+  with 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.14.0-20210324/packages.dhall sha256:b4564d575da6aed1c042ca7936da97c8b7a29473b63f4515f09bb95fae8dddab
+
+in  upstream

purescript/free/spago.dhall

@@ -0,0 +1,19 @@
+{-
+Welcome to a Spago project!
+You can edit this file as you like.
+-}
+{ name = "my-project"
+, dependencies =
+  [ "console"
+  , "debug"
+  , "effect"
+  , "fixed-points"
+  , "free"
+  , "psci-support"
+  , "tuples"
+  , "undefined"
+  , "variant"
+  ]
+, packages = ./packages.dhall
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
+}

purescript/free/src/Exists.purs

@@ -0,0 +1,14 @@
+module Existsential where
+
+import Prelude
+
+import Unsafe.Coerce (unsafeCoerce)
+
+foreign import data Test :: forall k. (k -> Type) -> Type
+foreign import data Exists :: forall a b. (a -> b) -> b
+
+mkExists :: forall f a. f a -> Exists f
+mkExists = unsafeCoerce
+
+runExists :: forall f r. (forall a. f a -> r) -> Exists f -> r
+runExists = unsafeCoerce

purescript/free/src/Lambda.purs

@@ -0,0 +1,43 @@
+module Lambda where
+
+import Prelude
+
+import Control.Monad.Free (Free, liftF, resume)
+import Data.Either (Either(..))
+import Existsential (Exists, mkExists, runExists)
+
+data CallData t f = CallData f (f -> t)
+data CallF a t = CallF (Exists (CallData t)) (t -> a)
+
+data LambdaF a
+    = Call (Exists (CallF a))
+
+type Lambda = Free LambdaF
+
+call :: forall a b. (a -> b) -> a -> Lambda b
+call f arg = liftF $ Call (mkExists (CallF callData identity))
+    where
+    callData = mkExists (CallData arg f)
+
+eval :: forall a. Lambda a -> a
+eval = resume >>> case _ of
+    Left (Call ex) -> eval $ run1 ex
+        where 
+        run1 :: forall r. Exists (CallF r) -> r
+        run1 = runExists (\(CallF ex' cb) -> cb $ run2 ex')
+
+        run2 :: forall t. Exists (CallData t) -> t
+        run2 = runExists (\(CallData arg f) -> f arg)
+    Right result -> result
+
+test :: Lambda Int
+test = do
+    result <- call ((+) 2) 3 
+    pure (result * 3)
+
+instance functorLambdaF :: Functor LambdaF where
+    map f (Call ex) = Call $ flip runExists ex (\(CallF ex' f') -> mkExists (CallF ex' $ f' >>> f))
+
+-- instance showLambda :: Show a => Show (LambdaF a) where
+--     show (Call left right) = show left <> " " <> show right
+--     show (Lambda arg body) = "(\\" <> arg <> " -> " <> show body <> ")"

purescript/free/src/Main.purs

@@ -0,0 +1,11 @@
+module Main where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Class.Console (logShow)
+import Lambda (eval, test)
+
+main :: Effect Unit
+main = do
+  logShow $ eval test

purescript/free/src/Math.purs

@@ -0,0 +1,34 @@
+module Math where
+
+import Prelude
+
+import Control.Monad.Free (Free, liftF, resume)
+import Data.Either (Either(..))
+
+data MathF a 
+    = Add Int Int (Int -> a)
+    | Multiply Int Int (Int -> a)
+
+type Math = Free MathF
+
+---------- Helpers
+eval :: Math Int -> Int
+eval = resume >>> case _ of
+    Right result -> result
+    Left (Add l r cb) -> eval $ cb $ l + r
+    Left (Multiply l r cb) -> eval $ cb $ l * r
+
+seven :: Math Int
+seven = do
+    four <- multiply_ 2 2
+    add_ four 3
+
+---------- Free boilerplate
+add_ :: Int -> Int -> Math Int
+add_ l r = liftF (Add l r identity)
+
+multiply_ :: Int -> Int -> Math Int
+multiply_ l r = liftF (Multiply l r identity)
+
+--------- Typeclass instances
+derive instance functorMath :: Functor MathF

purescript/free/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."