sync

Main.bnf

@@ -0,0 +1,12 @@
+<command> ::= <viewDeck> | <addDeck> | <deleteDeck> | "save" | "load"
+
+<viewDeck> ::= "view"
+<addDeck> ::= "add" <deck>
+<deleteDeck> ::= "delete"
+
+<deck> ::= <card> | <card> ", " <deck>
+<card> ::= <rank> "of" <suit> | "Joker"
+
+<rank> ::= <number> | "Jack" | "Queen" | "King" | "Ace"
+<number> ::= "Two" | "Three" | "Four" | "Five" | "Six" | "Seven" | "Eight" | "Nine" | "Ten"
+<suit> ::= "Hearts" | "Diamonds" | "Clubs" | "Spades"

README.md

@@ -9,3 +9,7 @@
 ### To Build & Test the Project, run the following commands
 1. `stack build`
 2. `stack test`
+
+### BNF
+1. **Added Command Structure**:
+   - `<command>` rule for `view`, `add`, `delete`.

app4-client/Main.hs

@@ -1,12 +1,82 @@
+{-# LANGUAGE DeriveFunctor #-}
+
 module Main (main) where
 
 import Data.ByteString
 import Network.Wreq
 import Data.String.Conversions
-import Control.Lens
+import Control.Lens 
+import Control.Monad.Free (Free (..), liftF)
+
+data MyDomainAlgebra next
+  = View (String -> next)
+  | Load (String -> next)
+  | Save (String -> next)
+  | Delete (String -> next)
+  | Add String (String -> next) 
+  deriving (Functor)
+
+type DeckProgram = Free MyDomainAlgebra
+
+view :: DeckProgram String
+view = liftF $ View id
+
+load :: DeckProgram String
+load = liftF $ Load id
+
+save :: DeckProgram String
+save = liftF $ Save id
+
+delete :: DeckProgram String
+delete = liftF $ Delete id
+
+add :: String -> DeckProgram String
+add s = liftF $ Add s id
+
+
+
+oneByOne :: DeckProgram a -> IO (String, a)
+oneByOne = runStep ""
+  where
+    runStep acc (Pure a) = return (acc, a)
+    runStep acc (Free (View next)) = do
+      putStrLn "Sending request: view"
+      resp <- post "http://localhost:3000" (cs "view" :: ByteString)
+      let responseStr = cs $ resp ^. responseBody
+      runStep (acc ++ "View Response: " ++ responseStr ++ "\n") (next responseStr)
+    runStep acc (Free (Load next)) = do
+      putStrLn "Sending request: load"
+      resp <- post "http://localhost:3000" (cs "load" :: ByteString)
+      let responseStr = cs $ resp ^. responseBody
+      runStep (acc ++ "Load Response: " ++ responseStr ++ "\n") (next responseStr)
+    runStep acc (Free (Save next)) = do
+      putStrLn "Sending request: save"
+      resp <- post "http://localhost:3000" (cs "save" :: ByteString)
+      let responseStr = cs $ resp ^. responseBody
+      runStep (acc ++ "Load Response: " ++ responseStr ++ "\n") (next responseStr)
+    runStep acc (Free (Delete next)) = do
+      putStrLn "Sending request: delete"
+      resp <- post "http://localhost:3000" (cs "delete" :: ByteString)
+      let responseStr = cs $ resp ^. responseBody
+      runStep (acc ++ "Load Response: " ++ responseStr ++ "\n") (next responseStr)
+    runStep acc (Free (Add s next)) = do
+      putStrLn ("Adding: " ++ s)
+      resp <- post "http://localhost:3000" (cs ("add " ++ s) :: ByteString)
+      let responseStr = cs $ resp ^. responseBody
+      runStep (acc ++ "Add Response: " ++ responseStr ++ "\n") (next responseStr)
+
+
+program :: DeckProgram String
+program = do
+    Main.delete
+    load
+    add "Two of Spades, Joker"
+    Main.view
+
+
 
 main :: IO ()
 main = do
-    let rawRequest = cs "works?" :: ByteString
-    resp <- post "http://localhost:3000" rawRequest
-    putStrLn $ cs $ resp ^. responseBody
+    (responses, _) <- oneByOne program
+    putStrLn "Accumulated Responses:"
+    putStrLn responses

app4-server/Main.hs

@@ -1,13 +1,35 @@
 {-# LANGUAGE OverloadedStrings #-}
+
 module Main (main) where
 
-import Control.Monad.IO.Class(liftIO)
-import Data.String.Conversions
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Chan (Chan, newChan)
+import Control.Concurrent.STM (TVar, newTVarIO)
+import Control.Monad.IO.Class (liftIO)
+import Data.Maybe (fromMaybe)
+import Data.String.Conversions (cs)
+import qualified Lib2
+import qualified Lib3
 import Web.Scotty
 
 main :: IO ()
-main = scotty 3000 $
+main = do
+  chan <- newChan :: IO (Chan Lib3.StorageOp)
+  state <- newTVarIO Lib2.emptyState
+  _ <- forkIO $ Lib3.storageOpLoop chan
+  scotty 3000 $
     post "/" $ do
-        b <- body
-        liftIO $ putStrLn $ concat ["Request was: ", cs b]
-        text $ "This is response"
+      b <- body
+      liftIO $ putStrLn ("Request was: " ++ cs b)
+      response <- liftIO $ proccess state chan $ cs b
+      text $ cs response
+
+proccess :: TVar Lib2.State -> Chan Lib3.StorageOp -> String -> IO String
+proccess state storageChan input = case Lib3.parseCommand input of
+  Left e -> return e
+  Right (cmd, "") -> do
+    info <- Lib3.stateTransition state cmd storageChan
+    case info of
+      Left e -> return e
+      Right mb -> return $ fromMaybe "Success" mb
+  Right (_, str) -> return $ "Could not parse: " ++ str

fp2024.cabal

@@ -42,6 +42,7 @@ library
       Lib1
       Lib2
       Lib3
+      Parsers
   other-modules:
       Paths_fp2024
   autogen-modules:
@@ -74,7 +75,9 @@ executable fp2024-four-client
       base >=4.7 && <5
     , bytestring
     , fp2024
+    , free
     , lens
+    , mtl
     , repline
     , string-conversions
     , wreq
@@ -92,8 +95,10 @@ executable fp2024-four-server
   build-depends:
       base >=4.7 && <5
     , fp2024
+    , mtl
     , repline
     , scotty
+    , stm
     , string-conversions
   default-language: Haskell2010
 

lab2_example.txt

@@ -0,0 +1,18 @@
+>>> view
+The deck is empty.
+>>> add Two of Hearts
+Card added.
+>>> view
+Two of Hearts
+>>> add Three of Diamonds, Jack of Clubs
+Deck added.
+>>> view
+Three of Diamonds, Jack of Clubs, Two of Hearts
+>>> delete
+Deck deleted.
+>>> view
+The deck is empty.
+>>> add Joker
+Card added.
+>>> view
+Joker

lab3_example.txt

@@ -0,0 +1,22 @@
+>>> load
+Deck deleted.
+Deck added.
+>>> view
+Two of Spades, King of Diamonds, Joker
+>>> delete
+Deck deleted.
+>>> add Joker, Queen of Hearts
+Deck added.
+>>> view
+Joker, Queen of Hearts
+>>> save
+State saved.
+>>> delete
+Deck deleted.
+>>> view
+The deck is empty.
+>>> load
+Deck deleted.
+Deck added.
+>>> view
+Joker, Queen of Hearts

package.yaml

@@ -93,6 +93,8 @@ executables:
     - wreq
     - bytestring
     - string-conversions
+    - free
+    - mtl
   fp2024-four-server:
     main:                Main.hs
     source-dirs:         app4-server
@@ -105,6 +107,8 @@ executables:
     - repline
     - scotty
     - string-conversions
+    - stm
+    - mtl
 
 tests:
   fp2024-test:

src/Lessons/Lesson14.hs

@@ -2,6 +2,7 @@
 module Lessons.Lesson14 () where
 
 import Control.Monad.Trans.Class(lift, MonadTrans)
+import Control.Monad.Trans.State
 
 newtype EitherT e m a = EitherT {
     runEitherT :: m (Either e a)

src/Lib1.hs

@@ -5,4 +5,4 @@ module Lib1
 -- | This function returns a list of words
 -- to be autocompleted in your program's repl.
 completions :: [String]
-completions = []
+completions = ["save","load","view","add <deck>","delete"]

src/Lib2.hs

@@ -1,44 +1,55 @@
-{-# LANGUAGE InstanceSigs #-}
+
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Redundant lambda" #-}
+{-# HLINT ignore "Use newtype instead of data" #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+
 module Lib2
-    ( Query(..),
+    (Query(..),
     parseQuery,
     State(..),
     emptyState,
-    stateTransition
-    ) where
-
--- | An entity which represets user input.
--- It should match the grammar from Laboratory work #1.
--- Currently it has no constructors but you can introduce
--- as many as needed.
-data Query
+    stateTransition,
+    Deck(..),
+    Card(..),
+    Rank(..),
+    Suit(..),
+    Number(..)
+    )
+where
+
+import Control.Applicative (Alternative (empty), optional, (<|>))
+import Parsers
 
--- | The instances are needed basically for tests
-instance Eq Query where
-  (==) _ _= False
 
-instance Show Query where
-  show _ = ""
-
--- | Parses user's input.
--- The function must have tests.
+-- <command> ::= <viewDeck> | <addDeck> | <deleteDeck>
 parseQuery :: String -> Either String Query
-parseQuery _ = Left "Not implemented 2"
+parseQuery input =
+    let (result, _) = parse (parseView <|> parseDelete <|> parseAddDeck) input
+    in result
 
--- | An entity which represents your program's state.
--- Currently it has no constructors but you can introduce
--- as many as needed.
-data State
+data State = State (Maybe Deck)
+  deriving(Eq,Show)
 
--- | Creates an initial program's state.
--- It is called once when the program starts.
 emptyState :: State
-emptyState = error "Not implemented 1"
+emptyState = State Nothing
 
--- | Updates a state according to a query.
--- This allows your program to share the state
--- between repl iterations.
--- Right contains an optional message to print and
--- an updated program's state.
 stateTransition :: State -> Query -> Either String (Maybe String, State)
-stateTransition _ _ = Left "Not implemented 3"
+stateTransition (State maybeDeck) query = case query of
+    ViewDeck ->
+        case maybeDeck of
+            Just deck -> Right (Just (show deck), State maybeDeck)
+            Nothing -> Right (Just "The deck is empty.", State maybeDeck)
+    AddDeck newDeck ->
+        let updatedDeck = case maybeDeck of
+                Just existingDeck -> mergeDecks newDeck existingDeck
+                Nothing -> newDeck
+            message = case newDeck of
+                SingleCard _ -> "Card added."
+                Deck _ _ -> "Deck added."
+        in Right (Just message, State (Just updatedDeck))
+    DeleteDeck ->
+        Right (Just "Deck deleted.", State Nothing)
+
+