adds recipe CapabilityPatternWithCheckedExceptions

README.md

@@ -97,6 +97,7 @@ Running a web-compatible recipe:
 |   | :heavy_check_mark: ([try](https://try.ps.ai/?github=JordanMartinez/purescript-cookbook/master/recipes/ButtonsHalogenHooks/src/Main.purs)) | [ButtonsHalogenHooks](recipes/ButtonsHalogenHooks) | A Halogen port of the ["User Input - Buttons" Elm Example](https://elm-lang.org/examples/buttons). |
 |   | :heavy_check_mark: ([try](https://try.ps.ai/?github=JordanMartinez/purescript-cookbook/master/recipes/ButtonsReactHooks/src/Main.purs)) | [ButtonsReactHooks](recipes/ButtonsReactHooks) | A React port of the ["User Input - Buttons" Elm Example](https://elm-lang.org/examples/buttons). |
 | :heavy_check_mark: |   | [CapabilityPatternNode](recipes/CapabilityPatternNode) | A skeletal version of an application structuring pattern |
+| :heavy_check_mark: |   | [CapabilityPatternWithCheckedExceptionsNode](recipes/CapabilityPatternWithCheckedExceptionsNode) | An enhancement of the CapabilityPattern Recipe, which adds `typed-exceptions` |
 |   | :heavy_check_mark: ([try](https://try.ps.ai/?github=JordanMartinez/purescript-cookbook/master/recipes/CardsHalogenHooks/src/Main.purs)) | [CardsHalogenHooks](recipes/CardsHalogenHooks) | A Halogen port of the ["Random - Cards" Elm Example](https://elm-lang.org/examples/cards). |
 |   | :heavy_check_mark: ([try](https://try.ps.ai/?github=JordanMartinez/purescript-cookbook/master/recipes/CardsReactHooks/src/Main.purs)) | [CardsReactHooks](recipes/CardsReactHooks) | A React port of the ["Random - Cards" Elm Example](https://elm-lang.org/examples/cards). |
 |   | :heavy_check_mark: ([try](https://try.ps.ai/?github=JordanMartinez/purescript-cookbook/master/recipes/CatGifsHalogenHooks/src/Main.purs)) | [CatGifsHalogenHooks](recipes/CatGifsHalogenHooks) | A Halogen port of the ["HTTP - Cat GIFs" Elm Example](https://elm-lang.org/examples/cat-gifs). |

recipes/CapabilityPatternWithCheckedExceptionsNode/.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/CapabilityPatternWithCheckedExceptionsNode/README.md

@@ -0,0 +1,20 @@
+# CapabilityPatternWithCheckedExceptionsNode
+
+An enhancement of the CapabilityPattern Recipe, which adds `typed-exceptions`
+
+It's best to be completely familiar with the design and implementation of that recipe before looking at this one. 
+
+Additionally, you should familiarize yourself with the [README](https://github.com/natefaubion/purescript-checked-exceptions) from `checked-exceptions`.
+
+## Expected Behavior:
+
+The `main` runs the `program` in a specialized monadic context (`AppExcVM`) which provides `Reader`, `Aff` and `ExceptV` instances in addition to the _capabilities_ required by the `program`, namely ability to `log` and `getUserName`. 
+
+In the implementation of `getUserName` we - somewhat artificially - use two additional services, each of which can give rise to a class of thrown errors / exceptions. We show how, provided these errors are all matched to error handling functions, the exceptions can be guaranteed not to escape from our monadic context.
+
+### Node.js
+
+Prints the contents of this repo's LICENSE file. Note that this recipe is run from the repo's root directory.
+
+
+

recipes/CapabilityPatternWithCheckedExceptionsNode/async.txt

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

recipes/CapabilityPatternWithCheckedExceptionsNode/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/CapabilityPatternWithCheckedExceptionsNode/spago.dhall

@@ -0,0 +1,13 @@
+{ name = "CapabilityPatternWithCheckedExceptionsNode"
+, dependencies =
+  [ "aff"
+  , "assert"
+  , "console"
+  , "effect"
+  , "transformers"
+  , "checked-exceptions"
+  , "typelevel-prelude"
+  ]
+, packages = ../../packages.dhall
+, sources = [ "recipes/CapabilityPatternWithCheckedExceptionsNode/src/**/*.purs" ]
+}

recipes/CapabilityPatternWithCheckedExceptionsNode/src/Application.purs

@@ -0,0 +1,26 @@
+module App.Application where -- Layers 4 & 3 common to Production and Test
+
+import App.Types (Name, getName)
+import Prelude (class Monad, Unit, bind, discard, pure, ($), (<>))
+
+-- | Layer 3
+-- | "business" logic: effectful functions
+
+-- | Monads to define each capability required by the program
+class (Monad m) <= Logger m where
+    log :: String -> m Unit
+
+class (Monad m) <= GetUserName m where
+    getUserName :: m Name
+
+-- | a program that will run in _any_ monad that can fulfill the
+-- | requirements (Logger and GetUserName)
+program :: forall m.
+    Logger m =>
+    GetUserName m =>
+    m String
+program = do
+    log "what is your name?"
+    name <- getUserName
+    log $ "Your name is " <> getName name
+    pure $ getName name

recipes/CapabilityPatternWithCheckedExceptionsNode/src/Main.purs

@@ -0,0 +1,16 @@
+module CapabilityPatternWithCheckedExceptionsNode.Main where
+
+import Prelude
+
+import App.Application (program)
+import App.ProductionExcV as AppExcVM
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+
+-- | See CapabilityPatternNode for other, simpler, examples of this pattern
+
+-- | Layer 0 - Running the `program` in this context
+main :: Effect Unit
+main = launchAff_ do
+  result <- AppExcVM.runApp program { url: "http://www.purescript.org"}
+  pure unit

recipes/CapabilityPatternWithCheckedExceptionsNode/src/ProductionExcV.purs

@@ -0,0 +1,121 @@
+module App.ProductionExcV where
+
+import Prelude
+
+import App.Application (class GetUserName, class Logger)
+import App.Types (Name(..))
+import Control.Monad.Error.Class (class MonadThrow, throwError)
+import Control.Monad.Except (runExceptT)
+import Control.Monad.Except.Checked (ExceptV, handleError, safe)
+import Control.Monad.Reader (class MonadAsk, ReaderT, ask, asks, runReaderT)
+import Data.Either (Either(..))
+import Data.Variant (class VariantShows, Variant)
+import Data.Variant.Internal (class VariantTags, RProxy(..))
+import Effect.Aff (Aff, error)
+import Effect.Aff.Class (class MonadAff)
+import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Class.Console as Console
+import Prim.RowList (class RowToList)
+import Service.FS (class MonadFs, FsError)
+import Service.FS (write) as FS
+import Service.HTTP (class MonadHttp, HttpError)
+import Service.HTTP (get) as HTTP
+import Type.Data.Row (RProxy)
+import Type.Equality (class TypeEquals, from)
+import Type.Row (type (+))
+
+-- the type that we expect to be in the ReaderT as our environment
+type Environment = { url :: String }
+
+-- | Aff wrapped in ExceptV wrapped in ReaderT
+newtype AppExcVM var a = AppExcVM (ReaderT Environment (ExceptV var Aff) a)
+
+-- | ...and the means to run computations in it
+runApp :: forall a. AppExcVM () a -> Environment -> Aff a
+runApp = runAppExcVM (RProxy :: _ ())
+  where
+    runAppExcVM :: forall var rl.
+      RowToList var rl =>
+      VariantTags rl =>
+      VariantShows rl =>
+      RProxy var ->
+      AppExcVM var a ->
+      Environment ->
+      Aff a
+    runAppExcVM _ (AppExcVM appExcVM) env = do
+      ran <- runExceptT $ runReaderT appExcVM env
+      case ran of
+        Right result -> pure result
+        Left err     -> throwError $ error $ show err
+
+-- | Layer 1 all the instances for the AppExcVM monad
+derive newtype instance monadAffAppExcVM    :: MonadAff (AppExcVM var)
+derive newtype instance monadEffectAppExcVM :: MonadEffect (AppExcVM var)
+derive newtype instance monadAppExcVM       :: Monad (AppExcVM var)
+derive newtype instance applicativeAppExcVM :: Applicative (AppExcVM var)
+derive newtype instance applyAppExcVM       :: Apply (AppExcVM var)
+derive newtype instance functorAppExcVM     :: Functor (AppExcVM var)
+derive newtype instance bindAppExcVM        :: Bind (AppExcVM var)
+derive newtype instance monadErrorAppExcVM  :: MonadThrow (Variant var) (AppExcVM var)
+
+-- | Capability instances
+instance monadHttpAppExcVM :: MonadHttp (AppExcVM var)
+
+instance monadFSAppExcVM   :: MonadFs (AppExcVM var)
+
+instance monadAskAppExcVM :: TypeEquals e1 Environment => MonadAsk e1 (AppExcVM v) where
+  ask = AppExcVM $ asks from
+
+instance loggerAppExcVM :: Logger (AppExcVM var) where
+  log msg = liftEffect $ Console.log msg
+
+instance getUserNameAppExcVM :: GetUserName (AppExcVM var) where
+  getUserName = do
+    env <- ask
+
+    name <- safe $ (getPureScript env.url) # handleError (errorHandlersWithDefault "there was an error!")
+
+    pure $ Name name
+
+-- | an example of a function which combines the underlying services and thus
+-- | has the possibility of raising errors from either one
+
+getPureScript :: forall m r
+  .  Monad m
+  => MonadHttp m
+  => MonadFs m
+  => String -> ExceptV  (HttpError + FsError + r) m String
+getPureScript url = do
+  HTTP.get url >>= FS.write "~/purescript.html"
+  pure "some result"
+
+
+-- | this function is used to declutter the implementation of `getUserName`
+-- | Provides exception handling functions for the _combined_ exceptions of HTTP and FS services
+-- | such that the `ExceptV` can be entirely unwrapped, using `safe` from `checked-exceptions`
+errorHandlersWithDefault :: forall m a.
+  MonadEffect m =>
+  a -> 
+  { fsFileNotFound     :: String -> m a
+  , fsPermissionDenied :: Unit -> m a
+  , httpNotFound       :: Unit -> m a
+  , httpOther          :: { body :: String, status :: Int} -> m a
+  , httpServerError    :: String -> m a
+  }
+errorHandlersWithDefault defaultValue = {
+    httpServerError:    \error -> do
+      Console.log $ "Server error:" <> error
+      pure defaultValue
+  , httpNotFound:       \error -> do
+      Console.log "Not found"
+      pure defaultValue
+  , httpOther:          \error -> do
+      Console.log $ "Other: { status: " <> show error.status <> " , body: " <> error.body <> "}"
+      pure defaultValue
+  , fsFileNotFound:     \error -> do
+      Console.log $ "File Not Found" <> error
+      pure defaultValue
+  , fsPermissionDenied: \error -> do
+      Console.log "Permission Denied"
+      pure defaultValue
+}

recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/Fs.purs

@@ -0,0 +1,41 @@
+module Service.FS where
+
+import Prelude (class Monad, Unit, pure, unit)
+
+import Type.Row (type (+))
+import Control.Monad.Except.Checked (ExceptV)
+import Data.Variant (SProxy(..), inj, Variant)
+
+
+-- | This module is an empty definition for an exception raising monadic interface to a file system
+
+-- | Here's the fake file system monad for demonstration purposes
+class (Monad m) <= MonadFs m
+
+-- | dummy definition for FilePath, in reality you'd source from, for example, Node.FS
+type FilePath = String
+
+-- | we wish to export this checked-exception wrapper for some underlying FS operation
+write ∷ ∀ r m. MonadFs m ⇒ 
+  FilePath → String → ExceptV (FsError + r) m Unit
+-- | NB this is the point where you'd connect to the underlying infrastructure such as NodeFS
+write filePath string = pure unit 
+
+-- | Typed exceptions that can arise in MonadFS
+type FsPermissionDenied r = (fsPermissionDenied ∷ Unit | r)
+type FsFileNotFound r     = (fsFileNotFound ∷ FilePath | r)
+
+fsPermissionDenied ∷ ∀ r. Variant (FsPermissionDenied + r)
+fsPermissionDenied = inj (SProxy ∷ SProxy "fsPermissionDenied") unit
+
+fsFileNotFound ∷ ∀ r. FilePath → Variant (FsFileNotFound + r)
+fsFileNotFound = inj (SProxy ∷ SProxy "fsFileNotFound")
+
+-- | Open row of exceptions that can be raised here, allowing for unification with
+-- | other open rows such as, in this recipe, the HttpError row
+type FsError r =
+  ( FsPermissionDenied
+  + FsFileNotFound
+  + r
+  )
+

recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/Http.purs

@@ -0,0 +1,43 @@
+module Service.HTTP where
+
+import Control.Monad.Except.Checked (ExceptV)
+import Data.Variant (SProxy(..), Variant, inj)
+import Prelude (class Monad, Unit, pure, unit)
+import Type.Row (type (+))
+
+-- | This module is an empty definition for an exception raising monadic interface to Http service
+
+-- | Here's the fake HTTP monad for demonstration purposes
+class (Monad m) <= MonadHttp m
+
+-- | we wish to export this checked-exception wrapper for some underlying HTTP operation
+get ∷ ∀ r m.
+  MonadHttp m ⇒ 
+  String ->
+  ExceptV (HttpError + r) m String
+-- | NB this is the point where you'd connect to the underlying GET, POST etc
+get url = pure "dummy result from getHttp"
+
+
+-- Typed exceptions that can arise in MonadHttp
+type HttpServerError r = (httpServerError ∷ String | r)
+type HttpNotFound    r = (httpNotFound ∷ Unit | r)
+type HttpOther       r = (httpOther ∷ { status ∷ Int, body ∷ String } | r)
+
+httpServerError ∷ ∀ r. String → Variant (HttpServerError + r)
+httpServerError = inj (SProxy ∷ SProxy "httpServerError")
+
+httpNotFound ∷ ∀ r. Variant (HttpNotFound + r)
+httpNotFound = inj (SProxy ∷ SProxy "httpNotFound") unit
+
+httpOther ∷ ∀ r. Int → String → Variant (HttpOther + r)
+httpOther status body = inj (SProxy ∷ SProxy "httpOther") { status, body }
+
+-- | Open row of exceptions that can be raised here, allowing for unification with
+-- | other open rows such as, in this recipe, the FsError row
+type HttpError r =
+  ( HttpServerError
+  + HttpNotFound
+  + HttpOther
+  + r
+  )

recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/README.md

@@ -0,0 +1,6 @@
+# Services 
+
+This folder contains examples of two different, independent services whose
+errors / exceptions can be unified in a single `ExceptV` because they are using
+the `checked-exceptions` pattern. This enables us to combine these services, as
+in the implementation of the `getUserName` function for the RaveM Monad

recipes/CapabilityPatternWithCheckedExceptionsNode/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/CapabilityPatternWithCheckedExceptionsNode/sync.txt

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