Add heftia example

README.md

@@ -25,6 +25,7 @@ There are some docs describing each alternative
 - **app-bluefin** similar to `app2` and `app3` but uses [`bluefin`](https://hackage.haskell.org/package/bluefin) package as a type level alternative of the handler pattern.
 - 🚧 **app-effectful** uses [`effectful`](https://hackage.haskell.org/package/effectful)
   - TBD tests
+- **app-heftia** uses [`heftia`](https://hackage.haskell.org/package/heftia-effects)
 - 🚧 **app-polysemy**
 - ❌ ~~**app-capabilities** similar to `app5` but uses `Capabilities` package~~.
   - ❌ [`Capabilities`](https://hackage.haskell.org/package/Capabilities) packages only works for `base >= 4.5 && 4.6`. We are using 4.17. I wanted to try it out based on [its blog post](https://www.tweag.io/blog/2018-10-04-capability/)
@@ -50,4 +51,4 @@ Each app and test can be run with `cabal` directly.
 ```
 % cabal run app1
 % cabal test app1-test
-```
+```

app-heftia-test/Test.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Test (main) where
+
+import Books qualified as B
+import Control.Monad
+import Control.Monad.Hefty
+import Control.Monad.Hefty.Input
+import Control.Monad.Hefty.Output
+import Data.List
+import Data.Maybe
+import Main (Console (GetStringInput, PrintLine), main', runReadOnlyBookDB)
+import Test.Hspec
+
+runConsolePure :: (FOEs es) => [String] -> Eff (Console ': es) a -> Eff es ([String], a)
+runConsolePure inputLines action =
+  action
+    & reinterpret \case
+      GetStringInput prompt -> do
+        output prompt
+        fromMaybe "" <$> input
+      PrintLine line -> output line
+    & runInputList inputLines
+    & runOutputMonoid singleton
+
+main :: IO ()
+main = hspec $ do
+  around (B.withDB ":memory:") $ do
+    it "Showing a message when no books are found" $ \db -> do
+      (outputLines, _) <-
+        runEff
+          . runReadOnlyBookDB db
+          . runConsolePure ["Pri", ""]
+          $ main'
+
+      outputLines
+        `shouldBe` [ "Welcome to the Library"
+                   , "Search: "
+                   , "No books found for: Pri"
+                   , "Search: "
+                   , "Bye!"
+                   ]
+
+    it "User can perform searches and exit" $ \db -> do
+      let books =
+            [ B.Book{B.title = "Pride and Prejudice", B.author = "Jane Austen"}
+            , B.Book{B.title = "1984", B.author = "George Orwell"}
+            , B.Book{B.title = "Frankenstein", B.author = "Mary Shelley"}
+            ]
+      forM_ books $ B.addBook db
+
+      (outputLines, _) <-
+        runEff
+          . runReadOnlyBookDB db
+          . runConsolePure ["en", "or", ""]
+          $ main'
+
+      outputLines
+        `shouldBe` [ "Welcome to the Library"
+                   , "Search: "
+                   , " * Pride and Prejudice, Jane Austen"
+                   , " * Frankenstein, Mary Shelley"
+                   , "Search: "
+                   , " * 1984, George Orwell"
+                   , "Search: "
+                   , "Bye!"
+                   ]

app-heftia/Main.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Main where
+
+import Books hiding (findBook)
+import Books qualified as Book
+import Control.Monad
+import Control.Monad.Hefty
+import System.IO
+
+data Console :: Effect where
+  GetStringInput :: String -> Console f String
+  PrintLine :: String -> Console f ()
+makeEffectF ''Console
+
+runConsoleIO :: (Emb IO :> es) => Eff (Console ': es) a -> Eff es a
+runConsoleIO = interpret $ \case
+  GetStringInput prompt -> liftIO $ do
+    putStr prompt
+    hFlush stdout
+    getLine
+  PrintLine line -> liftIO $ putStrLn line
+
+data ReadOnlyBookDB :: Effect where
+  FindBook :: String -> ReadOnlyBookDB f [Book]
+makeEffectF ''ReadOnlyBookDB
+
+runReadOnlyBookDB :: (Emb IO :> es) => BookDB -> Eff (ReadOnlyBookDB : es) a -> Eff es a
+runReadOnlyBookDB db = interpret $ \case
+  FindBook q -> liftIO $ Book.findBook db q
+
+main :: IO ()
+main = do
+  withDB
+    "./books.db"
+    ( \db -> do
+        runEff
+          . runConsoleIO
+          . runReadOnlyBookDB db
+          $ main'
+    )
+
+main' :: (Console :> es, ReadOnlyBookDB :> es) => Eff es ()
+main' = do
+  printLine "Welcome to the Library"
+  loop
+
+loop :: (Console :> es, ReadOnlyBookDB :> es) => Eff es ()
+loop = do
+  query <- getStringInput "Search: "
+  case query of
+    "" ->
+      printLine "Bye!"
+    _ -> do
+      books <- findBook query
+      if null books
+        then
+          printLine $ "No books found for: " <> query
+        else
+          printBookList books
+      loop
+
+printBookList :: (Console :> es) => [Book] -> Eff es ()
+printBookList books =
+  forM_ books (\book -> printLine $ " * " <> book.title <> ", " <> book.author)

lambda-library.cabal

@@ -16,7 +16,7 @@ common warnings
     ghc-options: -Wall
 
 common defaults
-    default-extensions: 
+    default-extensions:
         OverloadedStrings,
         OverloadedRecordDot
     build-depends:
@@ -59,8 +59,8 @@ test-suite app1-test
     other-modules:
         Support
     build-depends:
-        bytestring >= 0.11.5 && < 0.12, 
-        utf8-string >= 1.0.2 && < 1.1, 
+        bytestring >= 0.11.5 && < 0.12,
+        utf8-string >= 1.0.2 && < 1.1,
         main-tester >= 0.2.0 && < 0.3
 
 executable app2
@@ -103,7 +103,7 @@ test-suite app4-test
     main-is:          Test.hs
     hs-source-dirs:   app4, app4-test
     build-depends:
-        mtl >= 2.2.2 && < 2.3
+        mtl >= 2.2.2 && < 2.4
     other-modules:
         Support
         Result
@@ -115,15 +115,15 @@ executable app5
     other-modules:
         App
     build-depends:
-        mtl >= 2.2.2 && < 2.3
+        mtl >= 2.2.2 && < 2.4
 
 test-suite app5-test
     import:           warnings, app-test
     type:             exitcode-stdio-1.0
     main-is:          Test.hs
     hs-source-dirs:   app5, app5-test
     build-depends:
-        mtl >= 2.2.2 && < 2.3
+        mtl >= 2.2.2 && < 2.4
     other-modules:
         Support
         App
@@ -141,3 +141,18 @@ executable app-effectful
     hs-source-dirs:   app-effectful
     build-depends:
         effectful >= 2.3.1 && < 2.4
+
+executable app-heftia
+    import:           warnings, app
+    main-is:          Main.hs
+    hs-source-dirs:   app-heftia
+    build-depends:
+        heftia-effects >= 0.6.0.1 && < 0.7
+
+test-suite app-heftia-test
+    import:           warnings, app-test
+    type:             exitcode-stdio-1.0
+    main-is:          Test.hs
+    hs-source-dirs:   app-heftia, app-heftia-test
+    build-depends:
+        heftia-effects >= 0.6.0.1 && < 0.7