From 8bbda7c76d74fb0f11e7c2ebe904bec4a4a8adbf Mon Sep 17 00:00:00 2001
From: Tom Ellis <tom-git@jaguarpaw.co.uk>
Date: Mon, 17 Jun 2024 10:36:18 +0100
Subject: [PATCH] Implement DB example/template

Thanks to Florian Beeres @cideM
---
 README.md                                   |  6 +++
 bluefin-examples/CHANGELOG.md               |  3 ++
 bluefin-examples/bluefin-examples.cabal     | 25 +++++++++
 bluefin-examples/src/Bluefin/Examples/DB.hs | 58 +++++++++++++++++++++
 cabal.project                               |  1 +
 5 files changed, 93 insertions(+)
 create mode 100644 bluefin-examples/CHANGELOG.md
 create mode 100644 bluefin-examples/bluefin-examples.cabal
 create mode 100644 bluefin-examples/src/Bluefin/Examples/DB.hs

diff --git a/README.md b/README.md
index 24af63c..1bf5e15 100644
--- a/README.md
+++ b/README.md
@@ -15,6 +15,12 @@ including
 For an introduction to Bluefin, see the docs in the
 [`Bluefin`](bluefin/src/Bluefin.hs) module.
 
+## Examples
+
+There is an `bluefin-examples` package which you can see in this
+repository at
+[`bluefin-examples/src/Bluefin/Examples`](bluefin-examples/src/Bluefin/Examples).
+
 ## Acknowledgements
 
 Tom Ellis would like to thank many individuals for their work related
diff --git a/bluefin-examples/CHANGELOG.md b/bluefin-examples/CHANGELOG.md
new file mode 100644
index 0000000..d3ca292
--- /dev/null
+++ b/bluefin-examples/CHANGELOG.md
@@ -0,0 +1,3 @@
+## 0.0.0.0
+
+* Implement DB example/template.  Thanks to Florian Beeres @cideM.
diff --git a/bluefin-examples/bluefin-examples.cabal b/bluefin-examples/bluefin-examples.cabal
new file mode 100644
index 0000000..368e909
--- /dev/null
+++ b/bluefin-examples/bluefin-examples.cabal
@@ -0,0 +1,25 @@
+cabal-version:      3.0
+name:               bluefin-examples
+version:            0.0.0.0
+license:            MIT
+license-file:       LICENSE
+author:             Tom Ellis
+maintainer:         Tom Ellis
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+description:        The Bluefin effect system, examples
+synopsis:           The Bluefin effect system, examples
+homepage:           https://github.com/tomjaguarpaw/bluefin
+bug-reports:        https://github.com/tomjaguarpaw/bluefin/issues
+
+common warnings
+    ghc-options: -Wall
+
+library
+    import:           warnings
+    exposed-modules:
+      Bluefin.Examples.DB
+    build-depends:
+      base, bluefin >= 0.0.6.0 && < 0.1
+    hs-source-dirs:   src
+    default-language: Haskell2010
diff --git a/bluefin-examples/src/Bluefin/Examples/DB.hs b/bluefin-examples/src/Bluefin/Examples/DB.hs
new file mode 100644
index 0000000..aaa4d57
--- /dev/null
+++ b/bluefin-examples/src/Bluefin/Examples/DB.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Bluefin.Examples.DB where
+
+import Bluefin.Compound (useImpl, useImplIn)
+import Bluefin.Eff (Eff, (:&), (:>))
+import qualified Bluefin.Eff as BF
+import Bluefin.Exception (Exception)
+import qualified Bluefin.Exception as BF
+import Bluefin.IO (IOE)
+import qualified Bluefin.IO as BF
+
+newtype DbHandle = DbHandle String deriving (Show)
+
+newtype UserId = UserId String deriving (Show, Eq)
+
+newtype User = User String deriving (Show)
+
+data DbEff es = MkDbEff
+  { queryImpl :: DbHandle -> UserId -> Eff es User
+  }
+
+query :: (e :> es) => DbEff e -> DbHandle -> UserId -> Eff es User
+query db dbHandle userId = useImpl $ queryImpl db dbHandle userId
+
+runDbEffIo ::
+  forall exEff dbEff es r.
+  (exEff :> es, dbEff :> es) =>
+  Exception String exEff ->
+  IOE dbEff ->
+  (forall e. DbEff e -> Eff (e :& es) r) ->
+  Eff es r
+runDbEffIo ex _ fn =
+  useImplIn
+    fn
+    ( MkDbEff
+        { queryImpl = \_ userId -> do
+            if userId == UserId "1"
+              then pure $ User "Alice"
+              else BF.throw ex "not found"
+        }
+    )
+
+main :: IO ()
+main = do
+  let dbHandle = DbHandle "db"
+
+  result <- BF.runEff $ \io -> BF.try $ \ex ->
+    runDbEffIo ex io $ \db -> do
+      u1 <- query db dbHandle (UserId "1")
+      BF.effIO io $ print u1
+      u2 <- query db dbHandle (UserId "2")
+      BF.effIO io $ print u2
+
+  case result of
+    Left err -> print err
+    Right _ -> print "success"
diff --git a/cabal.project b/cabal.project
index ffe546f..0ed34e3 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,3 +1,4 @@
 packages:
   bluefin/bluefin.cabal
   bluefin-internal/bluefin-internal.cabal
+  bluefin-examples/bluefin-examples.cabal