Implemented the RunCapabilityPatternNode recipe (#270)

README.md

@@ -150,6 +150,7 @@ Running a web-compatible recipe:
 |   | :heavy_check_mark: | [RoutingHashReactHooks](recipes/RoutingHashReactHooks) | This recipe shows how to use `purescript-routing` to do client-side hash-based routing in a React-based single-page application (SPA). |
 |   | :heavy_check_mark: | [RoutingPushHalogenClassic](recipes/RoutingPushHalogenClassic) | This recipe shows how to use `purescript-routing` to do client-side push-state routing in a Halogen-based single-page application (SPA). |
 |   | :heavy_check_mark: | [RoutingPushReactHooks](recipes/RoutingPushReactHooks) | This recipe shows how to use `purescript-routing` to do client-side push-state routing in a React-based single-page application (SPA). |
+| :heavy_check_mark: |   | [RunCapabilityPatternNode](recipes/RunCapabilityPatternNode) | A skeletal version of an application structuring pattern using purescript-run and free dsls. |
 |   | :heavy_check_mark: ([try](https://try.ps.ai/?github=JordanMartinez/purescript-cookbook/master/recipes/ShapesHalogenHooks/src/Main.purs)) | [ShapesHalogenHooks](recipes/ShapesHalogenHooks) | Demonstrates rendering of SVG shapes. |
 |   | :heavy_check_mark: ([try](https://try.ps.ai/?github=JordanMartinez/purescript-cookbook/master/recipes/ShapesReactHooks/src/Main.purs)) | [ShapesReactHooks](recipes/ShapesReactHooks) | Demonstrates rendering of SVG shapes. |
 |   | :heavy_check_mark: ([try](https://try.ps.ai/?github=JordanMartinez/purescript-cookbook/master/recipes/SignalRenderJs/src/Main.purs)) | [SignalRenderJs](recipes/SignalRenderJs) | [Signal](https://pursuit.purescript.org/packages/purescript-signal/10.1.0) demo that responds to user input and elapsed time. |

recipes/RunCapabilityPatternNode/.gitignore

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

recipes/RunCapabilityPatternNode/README.md

@@ -0,0 +1,61 @@
+# RunCapabilityPatternNode
+
+A skeletal version of an application structuring pattern using purescript-run and free dsls.
+
+Purescript-run [documentation](https://pursuit.purescript.org/packages/purescript-run/3.0.1)
+
+Expanded example of the original design pattern illustrated in Jordan Martinez'
+[reference](https://jordanmartinez.github.io/purescript-jordans-reference-site/content/21-Hello-World/05-Application-Structure/src/02-MTL/32-The-ReaderT-Capability-Design-Pattern.html).
+
+## What's in each "Layer"?
+
+### Layer 4 - Types
+
+Strong types & pure, total functions on those types
+
+You'd hope to write as much of your code in this layer as possible but in this
+skeleton it's intentionally almost empty because we're concerned with the less
+obvious business of adapting this bit to your application, infrastructure and
+runtime.
+
+### Layer 3 - Application
+
+Effectful functions - `program` and `capabilities`
+
+Called "business logic" in some descriptions of this pattern this layer
+contains code that essentially weaves together the concrete code from Layer 4
+with the abstract capabilities that can be provided _differently_ in different
+scenarios, such as a logging capability that maybe goes to the console in Test
+but goes to a Database or a socket or systemd or a logfile in development and
+production.
+
+This layer defines:
+
+- a _program_ that will run inside [Run](https://pursuit.purescript.org/packages/purescript-run/3.0.1/docs/Run#t:Run)
+- free-dsls for each _capability_
+
+The capabilities are like "empty holes" in our program. We fill them in later, in the interpreting stage.
+
+### Layer 2 (API) & Layer 1 (Infrastructure)
+
+Together these two layers define a complete instance of one monadic container for a program.
+Together they define:
+
+- a set of base effects we can interpret our base `program` to
+- a `run` function that runs the `program` (implemented as a composition of interpreters)
+
+There are three versions of this monadic container shown here:
+
+- _ProductionSync_ - which runs in Effect
+- _ProductionAsync_ - which runs in Reader & Aff
+- _Test_ - which doesn't need any extra effects to run
+
+### Layer 0 - Main
+
+This layer is where it all comes together. A `main` is called by the underlying runtime and runs the `program` in one or another Monad.
+
+## Expected Behavior:
+
+The `main` runs the `program` (see linked readme) in three successive, different monad contexts: `Aff`, `Effect` and `Test`.
+
+If you want to verify that a failing test would still terminate the process with an error, you can simply uncomment the second call to `Test.runApp`

recipes/RunCapabilityPatternNode/async.txt

@@ -0,0 +1 @@
+Ahab

recipes/RunCapabilityPatternNode/nodeSupported.md

@@ -0,0 +1,2 @@
+This file just indicates that the node backend is supported.
+It is used for CI and autogeneration purposes.

recipes/RunCapabilityPatternNode/spago.dhall

@@ -0,0 +1,15 @@
+{ name = "RunCapabilityPatternNode"
+, dependencies =
+  [ "aff"
+  , "assert"
+  , "console"
+  , "effect"
+  , "node-fs"
+  , "node-fs-aff"
+  , "node-readline"
+  , "transformers"
+  , "run"
+  ]
+, packages = ../../packages.dhall
+, sources = [ "recipes/RunCapabilityPatternNode/src/**/*.purs" ]
+}

recipes/RunCapabilityPatternNode/src/Application.purs

@@ -0,0 +1,46 @@
+module App.Application where -- Layers 4 & 3 common to Production and Test
+
+import App.Types (Name, getName)
+import Data.Symbol (SProxy(..))
+import Data.Variant.Internal (FProxy)
+import Prelude (class Functor, Unit, bind, discard, identity, pure, unit, ($), (<>))
+import Run (Run)
+import Run as Run
+
+-- | Layer 3
+-- | "business" logic: effectful functions
+
+-- We define our capabilities as free dsls
+data LoggerF a = Log String a
+newtype GetUserNameF a = GetUserName (Name -> a)
+
+-- We have to lift our free dsls into Run
+log :: forall r. String -> Run ( logger :: LOGGER | r ) Unit
+log str = Run.lift _logger $ Log str unit
+
+getUserName :: forall r. Run ( getUserName :: GET_USER_NAME | r ) Name
+getUserName = Run.lift _getUserName $ GetUserName identity
+
+-- | A program which makes us of the dsls we defined earlier.
+program :: forall r. Run ( logger :: LOGGER, getUserName :: GET_USER_NAME | r ) String
+program = do
+    log "what is your name?"
+    name <- getUserName
+    log $ "Your name is " <> getName name
+    pure $ getName name
+
+-- Free monads increase the boilerplate for defining the dsls 
+-- but greatly reduce the boilerplate needed for writing different interpreters
+
+
+derive instance loggerFunctor :: Functor LoggerF
+derive instance getUserNameFunctor :: Functor GetUserNameF
+
+type LOGGER = FProxy LoggerF
+type GET_USER_NAME = FProxy GetUserNameF
+
+_logger :: SProxy "logger"
+_logger = SProxy
+
+_getUserName :: SProxy "getUserName"
+_getUserName = SProxy

recipes/RunCapabilityPatternNode/src/Main.purs

@@ -0,0 +1,35 @@
+module RunCapabilityPatternNode.Main where
+
+import Prelude
+
+import App.Application (program)
+import App.Production.Async (Environment,  runApp) as Async
+import App.Production.Sync (Environment,  runApp) as Sync
+import App.Test (Environment, runApp) as Test
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Class.Console (log)
+import Test.Assert (assert)
+
+-- | Layer 0 - Running the `program` in three different contexts
+main :: Effect Unit
+main = launchAff_ do
+  -- we can do aff-ish things here with Async/ProductionA version
+  result <- Async.runApp { asyncEnv: "recipes/RunCapabilityPatternNode/async.txt" } program
+  -- ...also able to do synchronous things (within Aff) using liftEffect
+  liftEffect $ mainSync { productionEnv: "recipes/RunCapabilityPatternNode/sync.txt" }
+  liftEffect $ mainTest { testEnv: "Test" }
+
+-- Three different "main" functions for three different scenarios
+mainSync :: Sync.Environment -> Effect Unit
+mainSync env = void $ Sync.runApp env program
+
+mainTest :: Test.Environment -> Effect Unit
+mainTest _ = do
+  assert $ (Test.runApp program) == "succeeds"
+  log "first test succeeded, now a failing test which will crash"
+  -- assert $ (Test.runApp program) == "failing test"
+
+mainAff1 :: Async.Environment -> Effect Unit
+mainAff1 env = launchAff_ $ Async.runApp env program

recipes/RunCapabilityPatternNode/src/ProductionAsync.purs

@@ -0,0 +1,38 @@
+module App.Production.Async where
+-- Layer 1 & 2. You can split these in 2 different files if you feel the need to.
+
+import Prelude
+
+import App.Application (GET_USER_NAME, GetUserNameF(..), LOGGER, _getUserName)
+import App.Production.Sync as Sync
+import App.Types (Name(..))
+import Effect.Aff (Aff, Milliseconds(..), delay)
+import Effect.Aff.Class (liftAff)
+import Node.Encoding (Encoding(..))
+import Node.FS.Aff (readTextFile) as Async
+import Run (AFF, EFFECT, Run, on, runBaseAff', send)
+import Run as Run
+import Run.Reader (READER, ask, runReader)
+
+-- | Layer 2 Define our "Production" Monad but using Aff...
+type Environment = { asyncEnv :: String }
+
+-- The `GetUserName` dsl can be interpreted without 
+-- using `Reader` as an intermediate step (as shown in `ProductionSync`), 
+-- but I chose to use Reader here just to show off how you'd go about doing it.
+type AppMA r = Run ( reader :: READER Environment,  aff :: AFF, effect :: EFFECT | r )
+
+-- | Running our monad is just a matter of interpreter composition.
+runApp :: Environment -> AppMA ( logger :: LOGGER, getUserName :: GET_USER_NAME ) ~> Aff
+runApp env = Sync.runLogger >>> runGetUserName >>> runReader env >>> runBaseAff'
+
+runGetUserName :: forall r. AppMA ( getUserName :: GET_USER_NAME | r ) ~> AppMA r
+runGetUserName = Run.interpret (on _getUserName handleUserName send)
+  where
+  handleUserName :: GetUserNameF ~> AppMA r
+  handleUserName (GetUserName continue) = do
+    env <- ask
+    liftAff do -- but we can also run computations in Aff
+      delay $ Milliseconds 1000.0 -- 1 second
+      contents <- Async.readTextFile UTF8 env.asyncEnv
+      pure $ continue $ Name contents

recipes/RunCapabilityPatternNode/src/ProductionSync.purs

@@ -0,0 +1,36 @@
+module App.Production.Sync where
+-- Layer 1 & 2. You can split these in 2 different files if you feel the need to.
+
+import Prelude
+
+import App.Application (GetUserNameF(..), LOGGER, LoggerF(..), GET_USER_NAME, _getUserName, _logger)
+import App.Types (Name(..))
+import Effect (Effect)
+import Effect.Class (liftEffect)
+import Effect.Class.Console (log)
+import Node.Encoding (Encoding(..))
+import Node.FS.Sync (readTextFile) as Sync
+import Run (EFFECT, Run, on, runBaseEffect, send)
+import Run as Run
+
+-- | Layer 2 Define our "Production" Monad...
+type Environment = { productionEnv :: String }
+type AppM r = Run ( effect :: EFFECT | r )
+
+-- | Running our monad is just a matter of interpreter composition.
+runApp :: Environment -> AppM ( logger :: LOGGER, getUserName :: GET_USER_NAME ) ~> Effect
+runApp env = runLogger >>> runGetUserName env >>> runBaseEffect
+
+runLogger :: forall r. AppM ( logger :: LOGGER | r ) ~> AppM r
+runLogger = Run.interpret (on _logger handleLogger send)
+  where
+  handleLogger :: LoggerF ~> AppM r 
+  handleLogger (Log message a) = log message $> a
+
+runGetUserName :: forall r. Environment -> AppM ( getUserName :: GET_USER_NAME | r ) ~> AppM r
+runGetUserName env = Run.interpret (on _getUserName handleUserName send)
+  where
+  handleUserName :: GetUserNameF ~> AppM r
+  handleUserName (GetUserName continue) = do
+    contents <- liftEffect $ Sync.readTextFile UTF8 env.productionEnv
+    pure $ continue $ Name contents

recipes/RunCapabilityPatternNode/src/Test.purs

@@ -0,0 +1,30 @@
+module App.Test where
+-- Layer 1 & 2. You can split these in 2 different files if you feel the need to.
+
+import Prelude
+
+import App.Application (GetUserNameF(..), LOGGER, LoggerF(..), GET_USER_NAME, _getUserName, _logger)
+import App.Types (Name(..))
+import Run (Run, extract, on, send)
+import Run as Run
+
+-- | Layer 2 Define our "Test" Monad...
+
+type Environment = { testEnv :: String }
+type TestM r = Run r
+
+-- | Running our monad is just a matter of interpreter composition.
+runApp :: forall a. TestM ( logger :: LOGGER, getUserName :: GET_USER_NAME ) a -> a
+runApp = runLogger >>> runGetUserName  >>> extract
+
+runLogger :: forall r. TestM ( logger :: LOGGER | r ) ~> TestM r
+runLogger = Run.interpret (on _logger handleLogger send)
+  where
+  handleLogger :: LoggerF ~> TestM r 
+  handleLogger (Log _ a) = pure a
+
+runGetUserName :: forall r.  TestM ( getUserName :: GET_USER_NAME | r ) ~> TestM r
+runGetUserName = Run.interpret (on _getUserName handleUserName send)
+  where
+  handleUserName :: GetUserNameF ~> TestM r
+  handleUserName (GetUserName continue) = pure $ continue $ Name "succeeds"

recipes/RunCapabilityPatternNode/src/Types.purs

@@ -0,0 +1,13 @@
+module App.Types where -- Layers 4 & 3 common to Production and Test
+
+-- | Layer 4
+-- | Strong types & pure, total functions on those types
+newtype Name = Name String
+
+getName :: Name -> String
+getName (Name s) = s
+
+
+-- NB this is the smallest file in this skeletal example
+-- but if you can you'd like to have as much of your code
+-- as you possibly can in this Layer!!

recipes/RunCapabilityPatternNode/sync.txt

@@ -0,0 +1 @@
+Ishmael