├── .gitignore ├── Capability Patterns.pdf ├── LICENSE ├── README.md ├── async.txt ├── spago.dhall ├── src ├── LayerFour.purs ├── LayerThree.purs ├── Main.purs ├── Production.purs ├── ProductionA.purs └── Test.purs ├── sync.txt └── test └── Main.purs /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | /packages.dhall 3 | /output 4 | /.spago 5 | .vscode 6 | -------------------------------------------------------------------------------- /Capability Patterns.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/afcondon/purescript-capability-pattern/2234a5900678ed93033f2a4efb080f40afeec492/Capability Patterns.pdf -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Andrew Condon 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-capability-pattern 2 | Working *minimal* illustration of the Capability Design Pattern in PureScript 3 | 4 | (Somewhat) fully fleshed-out example of the design pattern illustrated in Jordan Martinez' phenomenal [collection](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) 5 | of reference material and examples 6 | 7 | I've added some `Aff` to the mix and made sure it compiles and does _something_ tho it's quite possible that i've made mistakes somewhere that make it imperfect as a starter template: PR's welcome. 8 | 9 | ## How to build and run it 10 | `spago install` & `spago run` should do it 11 | 12 | ## What's in each "Layer"? 13 | 14 | ### Layer 4 - Core - Innermost layer 15 | Strong types & pure, total functions on those types 16 | 17 | 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. 18 | 19 | ### Layer 3 - Domain - Effectful functions - `program` and `capabilities` 20 | 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. 21 | 22 | This layer defines: 23 | * a *program* that will run in some Monad (thus giving you freedom to run it in different Monads, see above) 24 | * all the *capabilities* that it will require of the Monad in which it runs 25 | 26 | The capabilities are like "container requirements", an API to a structure in which this program is embedded 27 | 28 | ### Layer 2 (API) & Layer 1 (Infrastructure) - a complete instance of one monadic container for a program 29 | These two layers need to be co-located in one file in PureScript. 30 | 31 | Together they define: 32 | * a particular Monad in which our `program` from Layer 3 can be run 33 | * a `run` function that runs the `program` in _this_ Monad 34 | * the instances for the Monad 35 | * Functor, Apply, Applicative, Bind & Monad can all be derived trivially 36 | * others that a particular Monad might need can be written explicitly 37 | * the instances that are required by the `program` in Layer 3, also will have to be written explicitly 38 | 39 | ### Layer 0 - Runtime 40 | 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. 41 | 42 | -------------------------------------------------------------------------------- /async.txt: -------------------------------------------------------------------------------- 1 | Ahab 2 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to a Spago project! 3 | You can edit this file as you like. 4 | -} 5 | { name = "my-project" 6 | , dependencies = 7 | [ "aff" 8 | , "assert" 9 | , "console" 10 | , "effect" 11 | , "node-fs" 12 | , "node-fs-aff" 13 | , "node-readline" 14 | , "psci-support" 15 | , "transformers" 16 | ] 17 | , packages = ./packages.dhall 18 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 19 | } 20 | -------------------------------------------------------------------------------- /src/LayerFour.purs: -------------------------------------------------------------------------------- 1 | module App.Layer.Four where -- Layers 4 & 3 common to Production and Test 2 | 3 | -- | Layer 4 4 | -- | Strong types & pure, total functions on those types 5 | newtype Name = Name String 6 | 7 | getName :: Name -> String 8 | getName (Name s) = s 9 | 10 | 11 | -- NB this is the smallest file in this skeletal example 12 | -- but if you can you'd like to have as much of your code 13 | -- as you possibly can in this Layer!! 14 | -------------------------------------------------------------------------------- /src/LayerThree.purs: -------------------------------------------------------------------------------- 1 | module App.Layer.Three where -- Layers 4 & 3 common to Production and Test 2 | 3 | import App.Layer.Four (Name, getName) 4 | import Prelude (class Monad, Unit, bind, discard, pure, ($), (<>)) 5 | 6 | -- | Layer 3 7 | -- | "business" logic: effectful functions 8 | 9 | -- | Monads to define each capability required by the program 10 | class (Monad m) <= Logger m where 11 | log :: String -> m Unit 12 | 13 | class (Monad m) <= GetUserName m where 14 | getUserName :: m Name 15 | 16 | -- | a program that will run in _any_ monad that can fulfill the 17 | -- | requirements (Logger and GetUserName) 18 | program :: forall m. 19 | Logger m => 20 | GetUserName m => 21 | m String 22 | program = do 23 | log "what is your name?" 24 | name <- getUserName 25 | log $ "Your name is " <> getName name 26 | pure $ getName name 27 | -------------------------------------------------------------------------------- /src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | 5 | import App.Layer.Production (runApp, Environment) as Sync 6 | import App.Layer.ProductionA (runApp, Environment) as Async 7 | import App.Layer.Test (runApp, Environment) as Test 8 | import App.Layer.Three (program) 9 | import Effect (Effect) 10 | import Effect.Aff (launchAff_) 11 | import Effect.Class (liftEffect) 12 | import Effect.Class.Console (log) 13 | import Test.Assert (assert) 14 | 15 | 16 | -- | Layer 0 Production 17 | main :: Effect Unit 18 | main = combinedMain 19 | 20 | 21 | -- Three different "main" functions for three different scenarios 22 | mainSync :: Sync.Environment -> Effect Unit 23 | mainSync env = do 24 | result <- Sync.runApp program env 25 | pure unit 26 | 27 | mainTest :: Test.Environment -> Effect Unit 28 | mainTest env = do 29 | assert $ (Test.runApp program env) == "succeeds" 30 | log "first test succeeded, now a failing test which will crash" 31 | assert $ (Test.runApp program env) == "failing test" 32 | 33 | mainAff1 :: Async.Environment -> Effect Unit 34 | mainAff1 env = launchAff_ do 35 | result <- Async.runApp program env 36 | pure unit 37 | 38 | 39 | 40 | -- mainAff more complicated version able to call mainSync and mainTest 41 | combinedMain :: Effect Unit 42 | combinedMain = launchAff_ do 43 | -- we can do aff-ish things here with Async/ProductionA version 44 | result <- Async.runApp program { asyncEnv: "async.txt" } 45 | -- ...also able to do synchronous things (within Aff) using liftEffect 46 | liftEffect $ mainSync { productionEnv: "sync.txt" } 47 | liftEffect $ mainTest { testEnv: "Test" } 48 | pure unit -------------------------------------------------------------------------------- /src/Production.purs: -------------------------------------------------------------------------------- 1 | module App.Layer.Production where 2 | -- Layers One and Two have to be in same file due to orphan instance restriction 3 | 4 | import Prelude 5 | 6 | import App.Layer.Four (Name(..)) 7 | import App.Layer.Three (class Logger, class GetUserName) 8 | import Control.Monad.Reader (class MonadAsk, ReaderT, ask, asks, runReaderT) 9 | import Effect (Effect) 10 | import Effect.Class (class MonadEffect, liftEffect) 11 | import Effect.Class.Console (log) as Console 12 | import Node.Encoding (Encoding(..)) 13 | import Node.FS.Sync (readTextFile) as Sync 14 | import Type.Equality (class TypeEquals, from) 15 | 16 | -- | Layer 2 Define our "Production" Monad... 17 | type Environment = { productionEnv :: String } 18 | newtype AppM a = AppM (ReaderT Environment Effect a) 19 | 20 | -- | ...and the means to run computations in it 21 | runApp :: forall a. AppM a -> Environment -> Effect a 22 | runApp (AppM reader_T) env = runReaderT reader_T env 23 | 24 | 25 | -- | Layer 1 Provide instances for all capabilities needed 26 | -- | Many of the instances are provided by deriving from the 27 | -- | underlying ReaderT... 28 | derive newtype instance functorAppM :: Functor AppM 29 | derive newtype instance applyAppM :: Apply AppM 30 | derive newtype instance applicativeAppM :: Applicative AppM 31 | derive newtype instance bindAppM :: Bind AppM 32 | derive newtype instance monadAppM :: Monad AppM 33 | derive newtype instance monadEffectAppM :: MonadEffect AppM 34 | 35 | -- | Reader instance not quite as simple a derivation as "derive newtype", 36 | -- | as it needs TypeEquals for the env 37 | instance monadAskAppM :: TypeEquals e Environment => MonadAsk e AppM where 38 | ask = AppM $ asks from 39 | 40 | -- | implementing Logger here just to the console, but in real world you'd use 41 | -- | the available Env to determine log levels, output destination, DB handles etc 42 | instance loggerAppM :: Logger AppM where 43 | log = liftEffect <<< Console.log 44 | 45 | -- | a version of getUserName that reads the name from a file 46 | -- | given in the Environment 47 | instance getUserNameAppM :: GetUserName AppM where 48 | getUserName = do 49 | env <- ask 50 | contents <- liftEffect $ Sync.readTextFile UTF8 env.productionEnv 51 | pure $ Name contents 52 | -------------------------------------------------------------------------------- /src/ProductionA.purs: -------------------------------------------------------------------------------- 1 | module App.Layer.ProductionA where 2 | -- Layers One and Two have to be in same file due to orphan instance restriction 3 | 4 | import Prelude 5 | 6 | import App.Layer.Four (Name(..)) 7 | import App.Layer.Three (class Logger, class GetUserName) 8 | import Control.Monad.Reader (class MonadAsk, ReaderT, ask, asks, runReaderT) 9 | import Effect.Aff (Aff, Milliseconds(..), delay) 10 | import Effect.Aff.Class (class MonadAff, liftAff) 11 | import Effect.Class (class MonadEffect, liftEffect) 12 | import Effect.Class.Console (log) as Console 13 | import Node.Encoding (Encoding(..)) 14 | import Node.FS.Aff (readTextFile) as Async 15 | import Type.Equality (class TypeEquals, from) 16 | 17 | -- | Layer 2 Define our "Production" Monad but using Aff... 18 | type Environment = { asyncEnv :: String } 19 | newtype AppMA a = AppMA (ReaderT Environment Aff a) 20 | 21 | -- | ...and the means to run computations in it 22 | runApp :: forall a. AppMA a -> Environment -> Aff a 23 | runApp (AppMA reader_T) env = runReaderT reader_T env 24 | 25 | -- | Layer 1 Production in Aff 26 | derive newtype instance functorAppMA :: Functor AppMA 27 | derive newtype instance applyAppMA :: Apply AppMA 28 | derive newtype instance applicativeAppMA :: Applicative AppMA 29 | derive newtype instance bindAppMA :: Bind AppMA 30 | derive newtype instance monadAppMA :: Monad AppMA 31 | derive newtype instance monadEffectAppMA :: MonadEffect AppMA 32 | derive newtype instance monadAffAppMA :: MonadAff AppMA 33 | 34 | -- | Reader instance not quite as simple a derivation as "derive newtype", 35 | -- | as it needs TypeEquals for the env 36 | instance monadAskAppMA :: TypeEquals e Environment => MonadAsk e AppMA where 37 | ask = AppMA $ asks from 38 | 39 | -- | implementing Logger here just to the console, but in real world you'd use 40 | -- | the available Env to determine log levels, output destination, DB handles etc 41 | -- | because this version runs in Aff you can do Aff-ish things here (not shown) 42 | instance loggerAppMA :: Logger AppMA where 43 | log = liftEffect <<< Console.log 44 | 45 | -- | a version of getUserName that reads the name from a file 46 | -- | given in the Environment 47 | instance getUserNameAppMA :: GetUserName AppMA where 48 | getUserName = do 49 | env <- ask -- we still have access to underlying ReaderT 50 | liftAff do -- but we can also run computations in Aff 51 | delay $ Milliseconds 1000.0 -- 1 second 52 | contents <- Async.readTextFile UTF8 env.asyncEnv 53 | pure $ Name $ contents 54 | -------------------------------------------------------------------------------- /src/Test.purs: -------------------------------------------------------------------------------- 1 | module App.Layer.Test where 2 | -- Layers 1 & 2 must be in same module due to orphan instance restriction 3 | 4 | import Prelude 5 | 6 | import App.Layer.Four (Name(..)) 7 | import App.Layer.Three (class Logger, class GetUserName) 8 | import Control.Monad.Reader (Reader, runReader) 9 | 10 | -- | Layer 2 Define our "Test" Monad... 11 | 12 | type Environment = { testEnv :: String } 13 | newtype TestM a = TestM (Reader Environment a) 14 | 15 | -- | ...and the means to run computations in it 16 | runApp :: forall a. TestM a -> Environment -> a 17 | runApp (TestM reader) env = runReader reader env 18 | 19 | -- | Layer 1 Provide instances for all capabilities needed 20 | -- | Many of the instances are provided by deriving from the 21 | -- | underlying Reader... 22 | derive newtype instance functorTestM :: Functor TestM 23 | derive newtype instance applyTestM :: Apply TestM 24 | derive newtype instance applicativeTestM :: Applicative TestM 25 | derive newtype instance bindTestM :: Bind TestM 26 | derive newtype instance monadTestM :: Monad TestM 27 | 28 | -- | Test doesn't have access to Effect so can't log to console 29 | instance loggerTestM :: Logger TestM where 30 | log _ = pure unit -- do nothing in test instance 31 | 32 | instance getUserNameTestM :: GetUserName TestM where 33 | getUserName = pure $ Name "succeeds" -- replace with better test 34 | -------------------------------------------------------------------------------- /sync.txt: -------------------------------------------------------------------------------- 1 | Ishmael 2 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Class.Console (log) 7 | 8 | main :: Effect Unit 9 | main = do 10 | log "🍝" 11 | log "You should add some tests." 12 | --------------------------------------------------------------------------------