diff --git a/README.md b/README.md index b8d6b9e0..14729860 100644 --- a/README.md +++ b/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). | diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/.gitignore b/recipes/CapabilityPatternWithCheckedExceptionsNode/.gitignore new file mode 100644 index 00000000..fcea5928 --- /dev/null +++ b/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/ diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/README.md b/recipes/CapabilityPatternWithCheckedExceptionsNode/README.md new file mode 100644 index 00000000..1b98779c --- /dev/null +++ b/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. + + + diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/async.txt b/recipes/CapabilityPatternWithCheckedExceptionsNode/async.txt new file mode 100644 index 00000000..93e103e9 --- /dev/null +++ b/recipes/CapabilityPatternWithCheckedExceptionsNode/async.txt @@ -0,0 +1 @@ +Ahab diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/nodeSupported.md b/recipes/CapabilityPatternWithCheckedExceptionsNode/nodeSupported.md new file mode 100644 index 00000000..7bd63dd1 --- /dev/null +++ b/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. diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/spago.dhall b/recipes/CapabilityPatternWithCheckedExceptionsNode/spago.dhall new file mode 100644 index 00000000..1943dce6 --- /dev/null +++ b/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" ] +} diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Application.purs b/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Application.purs new file mode 100644 index 00000000..78287ebf --- /dev/null +++ b/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 diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Main.purs b/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Main.purs new file mode 100644 index 00000000..50bc8297 --- /dev/null +++ b/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 diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/src/ProductionExcV.purs b/recipes/CapabilityPatternWithCheckedExceptionsNode/src/ProductionExcV.purs new file mode 100644 index 00000000..05f7870c --- /dev/null +++ b/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 +} diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/Fs.purs b/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/Fs.purs new file mode 100644 index 00000000..29a44d95 --- /dev/null +++ b/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 + ) + diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/Http.purs b/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/Http.purs new file mode 100644 index 00000000..1cfa00d2 --- /dev/null +++ b/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 + ) diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/README.md b/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Services/README.md new file mode 100644 index 00000000..2708aef7 --- /dev/null +++ b/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 diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Types.purs b/recipes/CapabilityPatternWithCheckedExceptionsNode/src/Types.purs new file mode 100644 index 00000000..d8c1711b --- /dev/null +++ b/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!! diff --git a/recipes/CapabilityPatternWithCheckedExceptionsNode/sync.txt b/recipes/CapabilityPatternWithCheckedExceptionsNode/sync.txt new file mode 100644 index 00000000..66927196 --- /dev/null +++ b/recipes/CapabilityPatternWithCheckedExceptionsNode/sync.txt @@ -0,0 +1 @@ +Ishmael