diff --git a/README.md b/README.md index a5395ca..49e3db0 100644 --- a/README.md +++ b/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 -``` \ No newline at end of file +``` diff --git a/app-heftia-test/Test.hs b/app-heftia-test/Test.hs new file mode 100644 index 0000000..f4eeec0 --- /dev/null +++ b/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!" + ] diff --git a/app-heftia/Main.hs b/app-heftia/Main.hs new file mode 100644 index 0000000..6f37870 --- /dev/null +++ b/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) diff --git a/lambda-library.cabal b/lambda-library.cabal index 5bdb889..ba5c233 100644 --- a/lambda-library.cabal +++ b/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,7 +115,7 @@ 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 @@ -123,7 +123,7 @@ test-suite app5-test 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