Merginimas

bnf.txt

@@ -0,0 +1,23 @@
+<command> ::= <create_command> | <modify_command> | <query_command>
+
+<create_command> ::= "create(" <toy> ")"
+<modify_command> ::= "modify(" <toy> "," <modification> ")"
+<query_command> ::= "query(" <query_type> ")"
+
+<modification> ::= <add_decoration> | <remove_decoration>
+<add_decoration> ::= "add(" <decoration> ")"
+<remove_decoration> ::= "remove(" <decoration> ")"
+
+<query_type> ::= "all_toys" | "toys_with_decoration(" <decoration> ")" | "toys_of_type(" <toy_type> ")"
+<toy_type> ::= "simple" | "composite" | "decorated"
+
+<toy> ::= <simple_toy> | <composite_toy> | <decorated_toy>
+<simple_toy> ::= "ball" | "doll" | "car" | "robot" | "train"
+<composite_toy> ::= "combine(" <toy_list> ")"
+<toy_list> ::= <toy> | <toy> "," <toy_list>
+<decorated_toy> ::= "decorate(" <toy> "," <decoration> ")"
+<decoration> ::= <color> | <size> | <material>
+<color> ::= "red" | "blue" | "green" | "yellow"
+<size> ::= "small" | "medium" | "large"
+<material> ::= "plastic" | "wood" | "metal"
+

src/Lessons/Lesson02.hs

@@ -44,7 +44,7 @@ dup'' l =
 -- >>> safeDiv 1 0
 -- Nothing
 -- >>> safeDiv 10 2
--- Just 5
+
 safeDiv :: Integer -> Integer -> Maybe Integer
 safeDiv _ 0 = Nothing
 safeDiv a b = Just (a `div` b)

src/Lessons/Lesson05.hs

@@ -16,6 +16,7 @@ many p = many' p []
 
 -- >>> parseManyAs ""
 -- Right ("","")
+
 -- >>> parseManyAs "aaab"
 -- Right ("aaa","b")
 -- >>> parseManyAs "baaab"

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 = ["toy", "simple_toy", "composite_toy", "toy_list", "decorated_toy", "decoration", "color", "size", "material"]

src/Lib2.hs

@@ -1,44 +1,212 @@
 {-# LANGUAGE InstanceSigs #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use camelCase" #-}
 module Lib2
     ( Query(..),
-    parseQuery,
-    State(..),
-    emptyState,
-    stateTransition
+      parseQuery,
+      State(..),
+      emptyState,
+      stateTransition,
+      Toy(..),
+      Decoration(..),
+      ToyType(..)
     ) 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.
+import qualified Data.Char as C
+import qualified Data.List as L
+-- | An entity which represents user input.
 data Query
+    = CreateCommand Toy
+    | ModifyCommand Toy Modification
+    | QueryCommand QueryType
+    deriving (Eq, Show)
 
--- | The instances are needed basically for tests
-instance Eq Query where
-  (==) _ _= False
+data Toy
+    = SimpleToy String
+    | CompositeToy [Toy]
+    | DecoratedToy Toy Decoration
+    deriving (Eq, Show)
 
-instance Show Query where
-  show _ = ""
+data Modification
+    = AddDecoration Decoration
+    | RemoveDecoration Decoration
+    deriving (Eq, Show)
+
+data QueryType
+    = AllToys
+    | ToysWithDecoration Decoration
+    | ToysOfType ToyType
+    deriving (Eq, Show)
+
+data ToyType = Simple | Composite | Decorated deriving (Eq, Show)
+
+data Decoration
+    = Color String
+    | Size String
+    | Material String
+    deriving (Eq, Show)
+
+-- Custom alternative for Maybe
+orElse :: Maybe a -> Maybe a -> Maybe a
+orElse (Just x) _ = Just x
+orElse Nothing y = y
 
 -- | Parses user's input.
--- The function must have tests.
 parseQuery :: String -> Either String Query
-parseQuery _ = Left "Not implemented 2"
+parseQuery input =
+    case parseCommand (stripSpaces input) of
+        Just (command, "") -> Right command
+        Just (_, leftover) -> Left $ "Parsing failed, leftover input: " ++ leftover
+        Nothing -> Left "Invalid command format"
+
+parseCommand :: String -> Maybe (Query, String)
+parseCommand input =
+    parseCreateCommand input `orElse`
+    parseModifyCommand input `orElse`
+    parseQueryCommand input
+
+parseCreateCommand :: String -> Maybe (Query, String)
+parseCreateCommand input = do
+    rest <- parseLiteral "create(" input
+    (toy, rest') <- parseToy rest
+    rest'' <- parseLiteral ")" rest'
+    return (CreateCommand toy, rest'')
+
+parseModifyCommand :: String -> Maybe (Query, String)
+parseModifyCommand input = do
+    rest <- parseLiteral "modify(" input
+    (toy, rest') <- parseToy rest
+    rest'' <- parseLiteral "," rest'
+    (mod, rest''') <- parseModification rest''
+    rest'''' <- parseLiteral ")" rest'''
+    return (ModifyCommand toy mod, rest'''')
+
+parseQueryCommand :: String -> Maybe (Query, String)
+parseQueryCommand input = do
+    rest <- parseLiteral "query(" input
+    (queryType, rest') <- parseQueryType rest
+    rest'' <- parseLiteral ")" rest'
+    return (QueryCommand queryType, rest'')
+
+parseModification :: String -> Maybe (Modification, String)
+parseModification input =
+    parseAddDecoration input `orElse`
+    parseRemoveDecoration input
+
+parseAddDecoration :: String -> Maybe (Modification, String)
+parseAddDecoration input = do
+    rest <- parseLiteral "add(" input
+    (decoration, rest') <- parseDecoration rest
+    rest'' <- parseLiteral ")" rest'
+    return (AddDecoration decoration, rest'')
+
+parseRemoveDecoration :: String -> Maybe (Modification, String)
+parseRemoveDecoration input = do
+    rest <- parseLiteral "remove(" input
+    (decoration, rest') <- parseDecoration rest
+    rest'' <- parseLiteral ")" rest'
+    return (RemoveDecoration decoration, rest'')
+
+parseQueryType :: String -> Maybe (QueryType, String)
+parseQueryType input =
+    (parseLiteral "all_toys" input >>= \rest -> return (AllToys, rest)) `orElse`
+    parseToysWithDecoration input `orElse`
+    parseToysOfType input
+
+parseToysWithDecoration :: String -> Maybe (QueryType, String)
+parseToysWithDecoration input = do
+    rest <- parseLiteral "toys_with_decoration(" input
+    (decoration, rest') <- parseDecoration rest
+    rest'' <- parseLiteral ")" rest'
+    return (ToysWithDecoration decoration, rest'')
+
+parseToysOfType :: String -> Maybe (QueryType, String)
+parseToysOfType input = do
+    rest <- parseLiteral "toys_of_type(" input
+    (toyType, rest') <- parseToyType rest
+    rest'' <- parseLiteral ")" rest'
+    return (ToysOfType toyType, rest'')
+
+parseToyType :: String -> Maybe (ToyType, String)
+parseToyType input =
+    (parseLiteral "simple" input >>= \rest -> return (Simple, rest)) `orElse`
+    (parseLiteral "composite" input >>= \rest -> return (Composite, rest)) `orElse`
+    (parseLiteral "decorated" input >>= \rest -> return (Decorated, rest))
+
+parseToy :: String -> Maybe (Toy, String)
+parseToy input =
+    parseSimpleToy input `orElse`
+    parseCompositeToy input `orElse`
+    parseDecoratedToy input
+
+parseSimpleToy :: String -> Maybe (Toy, String)
+parseSimpleToy input =
+    (parseLiteral "ball" input >>= \rest -> return (SimpleToy "ball", rest)) `orElse`
+    (parseLiteral "doll" input >>= \rest -> return (SimpleToy "doll", rest)) `orElse`
+    (parseLiteral "car" input >>= \rest -> return (SimpleToy "car", rest)) `orElse`
+    (parseLiteral "robot" input >>= \rest -> return (SimpleToy "robot", rest)) `orElse`
+    (parseLiteral "train" input >>= \rest -> return (SimpleToy "train", rest))
+
+parseCompositeToy :: String -> Maybe (Toy, String)
+parseCompositeToy input = do
+    rest <- parseLiteral "combine(" input
+    (toys, rest') <- parseToyList rest
+    rest'' <- parseLiteral ")" rest'
+    return (CompositeToy toys, rest'')
+
+parseToyList :: String -> Maybe ([Toy], String)
+parseToyList input = do
+    (toy, rest) <- parseToy input
+    case parseLiteral "," rest of
+        Just rest' -> do
+            (toys, rest'') <- parseToyList rest'
+            return (toy : toys, rest'')
+        Nothing -> return ([toy], rest)
+
+parseDecoratedToy :: String -> Maybe (Toy, String)
+parseDecoratedToy input = do
+    rest <- parseLiteral "decorate(" input
+    (toy, rest') <- parseToy rest
+    rest'' <- parseLiteral "," rest'
+    (decoration, rest''') <- parseDecoration rest''
+    rest'''' <- parseLiteral ")" rest'''
+    return (DecoratedToy toy decoration, rest'''')
+
+parseDecoration :: String -> Maybe (Decoration, String)
+parseDecoration input =
+    (parseLiteral "red" input >>= \rest -> return (Color "red", rest)) `orElse`
+    (parseLiteral "blue" input >>= \rest -> return (Color "blue", rest)) `orElse`
+    (parseLiteral "green" input >>= \rest -> return (Color "green", rest)) `orElse`
+    (parseLiteral "yellow" input >>= \rest -> return (Color "yellow", rest)) `orElse`
+    (parseLiteral "small" input >>= \rest -> return (Size "small", rest)) `orElse`
+    (parseLiteral "medium" input >>= \rest -> return (Size "medium", rest)) `orElse`
+    (parseLiteral "large" input >>= \rest -> return (Size "large", rest)) `orElse`
+    (parseLiteral "plastic" input >>= \rest -> return (Material "plastic", rest)) `orElse`
+    (parseLiteral "wood" input >>= \rest -> return (Material "wood", rest)) `orElse`
+    (parseLiteral "metal" input >>= \rest -> return (Material "metal", rest))
+
+stripSpaces :: String -> String
+stripSpaces = dropWhile (== ' ')
 
--- | An entity which represents your program's state.
--- Currently it has no constructors but you can introduce
--- as many as needed.
-data State
+parseLiteral :: String -> String -> Maybe String
+parseLiteral literal input
+    | literal `isPrefixOf` input = Just (drop (length literal) input)
+    | otherwise = Nothing
+    where
+        isPrefixOf prefix str = prefix == take (length prefix) str
+-- | Represents the program's state.
+data State = State
+    { toys :: [Toy]
+    } 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 { toys = [] }
 
 -- | 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 query = case query of
+    CreateCommand toy -> Right (Just "Toy created", state { toys = toy : toys state })
+    ModifyCommand _ _ -> Left "ModifyCommand not implemented"
+    QueryCommand AllToys -> Right (Just (show $ toys state), state)
+    _ -> Left "Unsupported query"

test/Spec.hs

@@ -15,8 +15,12 @@ unitTests :: TestTree
 unitTests = testGroup "Lib1 tests"
   [ testCase "List of completions is not empty" $
       null Lib1.completions @?= False,
-    testCase "Parsing case 1 - give a better name" $
-      Lib2.parseQuery "" @?= (Left "Some error message"),
-    testCase "Parsing case 2 - give a better name" $
-      Lib2.parseQuery "o" @?= (Left "Some error message")
+    testCase "Parse incomplete input" $
+      Lib2.parseQuery "o" @?= Left "Invalid command format",
+    testCase "Parse valid create command" $
+      Lib2.parseQuery "create(ball)" @?= Right (Lib2.CreateCommand (Lib2.SimpleToy "ball")),
+    testCase "Parse create command with composite toy" $
+      Lib2.parseQuery "create(combine(ball,car))" @?= Right (Lib2.CreateCommand (Lib2.CompositeToy [Lib2.SimpleToy "ball", Lib2.SimpleToy "car"])),
+    testCase "Parse create command with decorated toy" $
+      Lib2.parseQuery "create(decorate(doll,blue))" @?= Right (Lib2.CreateCommand (Lib2.DecoratedToy (Lib2.SimpleToy "doll") (Lib2.Color "blue")))
   ]