diff --git a/bower.json b/bower.json index d0049e9..2c9c529 100644 --- a/bower.json +++ b/bower.json @@ -18,5 +18,8 @@ "purescript-prelude": "^4.0.0", "purescript-transformers": "^4.1.0", "purescript-variant": "^5.0.0" + }, + "devDependencies": { + "purescript-spec": "^3.1.0" } } diff --git a/src/Control/Monad/Except/Checked.purs b/src/Control/Monad/Except/Checked.purs index 86b4b73..087702c 100644 --- a/src/Control/Monad/Except/Checked.purs +++ b/src/Control/Monad/Except/Checked.purs @@ -9,14 +9,21 @@ module Control.Monad.Except.Checked ( ExceptV , handleError , safe + , throw + , recordToVariant ) where import Prelude +import Control.Monad.Error.Class (class MonadThrow) import Control.Monad.Except (ExceptT, lift, throwError) import Data.Either (either) import Data.Newtype (unwrap) -import Data.Variant (class VariantMatchCases, Variant, case_, onMatch) +import Data.Symbol (class IsSymbol, SProxy(..)) +import Data.Variant (class VariantMatchCases, Variant, case_, expand, inj, onMatch) +import Prim.Row as R +import Prim.RowList as RL +import Record (get) import Type.Row (class RowToList, class Union) type ExceptV exc = ExceptT (Variant exc) @@ -50,3 +57,33 @@ safe ⇒ ExceptV () m a → m a safe = unwrap >>> map (either case_ identity) + +-- | Throws an exception into an `ExceptV`. Mostly for syntax sugar. +-- | +-- | ```purescript +-- | throw { httpNotFound: unit } +-- | ``` +throw :: forall a smallE bigE _1 m sym typ. + MonadThrow (Variant bigE) m => + Union smallE _1 bigE => + IsSymbol sym => + R.Cons sym typ () smallE => + RowToList smallE (RL.Cons sym typ RL.Nil) => + Record smallE -> + m a +throw v = throwError $ expand $ recordToVariant v + +-- | Allows for syntax sugar. A single-element `Record` will be transformed into +-- | a `Variant`. +-- | +-- | ```purescript +-- | recordToVariant { foo: "bar" } == inj (SProxy :: SProxy "foo") "bar" +-- | ``` +recordToVariant :: forall r sym typ. + IsSymbol sym => + R.Cons sym typ () r => + RowToList r (RL.Cons sym typ RL.Nil) => + Record r -> + Variant r +recordToVariant record = + inj (SProxy :: SProxy sym) $ get (SProxy :: SProxy sym) record diff --git a/test/Main.purs b/test/Main.purs new file mode 100644 index 0000000..66fd4ce --- /dev/null +++ b/test/Main.purs @@ -0,0 +1,29 @@ +module Test.Main where + +import Prelude + +import Control.Monad.Except.Checked (ExceptV, handleError, safe, throw) +import Data.Identity (Identity) +import Effect (Effect) +import Test.Spec (describe, it) +import Test.Spec.Assertions (shouldEqual) +import Test.Spec.Reporter.Console (consoleReporter) +import Test.Spec.Runner (run) + +main :: Effect Unit +main = run [consoleReporter] do + describe "checked-exceptions" do + describe "throw" do + it "throws and catches errors" do + let + request :: ExceptV Errors Identity String + request = do + _ <- throw { foo: "foo" } + pure "bar" + (request # handleError + { foo: (\s -> pure s) + , bar: (\s -> pure "bar") + } + # safe) `shouldEqual` (pure "foo") + +type Errors = ( foo :: String, bar :: Int )