From 3b0de65de145dddd5ea13f76b73ab76107545b45 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 19 Dec 2022 22:54:42 +0100 Subject: [PATCH] #18 & massive structure overhaul --- lib/RPGEngine.hs | 8 +- lib/{control => RPGEngine}/Input.hs | 19 ++- .../Internals/Data}/Game.hs | 10 +- .../Internals/Data}/Internals.hs | 32 +++- .../Internals/Data}/Player.hs | 4 +- .../Internals/Data}/State.hs | 14 +- .../Internals/Input.hs} | 37 ++-- lib/RPGEngine/Internals/Parse.hs | 20 +++ .../Internals/Parse/StructureElement.hs | 161 ++++++++++++++++++ lib/RPGEngine/Parse.hs | 8 + lib/{render => RPGEngine}/Render.hs | 27 +-- lib/control/Parse.hs | 132 -------------- rpg-engine.cabal | 22 ++- stack.yaml | 2 + test/ParsedToGameSpec.hs | 2 +- test/ParserSpec.hs | 120 ++++++++++--- 16 files changed, 397 insertions(+), 221 deletions(-) rename lib/{control => RPGEngine}/Input.hs (69%) rename lib/{data => RPGEngine/Internals/Data}/Game.hs (79%) rename lib/{data => RPGEngine/Internals/Data}/Internals.hs (69%) rename lib/{data => RPGEngine/Internals/Data}/Player.hs (77%) rename lib/{data => RPGEngine/Internals/Data}/State.hs (84%) rename lib/{control/InputHandling.hs => RPGEngine/Internals/Input.hs} (84%) create mode 100644 lib/RPGEngine/Internals/Parse.hs create mode 100644 lib/RPGEngine/Internals/Parse/StructureElement.hs create mode 100644 lib/RPGEngine/Parse.hs rename lib/{render => RPGEngine}/Render.hs (63%) delete mode 100644 lib/control/Parse.hs diff --git a/lib/RPGEngine.hs b/lib/RPGEngine.hs index d5ea2e7..1ab1fa5 100644 --- a/lib/RPGEngine.hs +++ b/lib/RPGEngine.hs @@ -5,9 +5,9 @@ module RPGEngine ( playRPGEngine ) where -import Game -import Render -import Input +import RPGEngine.Internals.Data.Game +import RPGEngine.Render +import RPGEngine.Input import Graphics.Gloss ( Color(..) @@ -33,5 +33,5 @@ playRPGEngine :: String -> Int -> IO() playRPGEngine title fps = do play window bgColor fps initGame render handleInputs step where window = initWindow title winDimensions winOffsets - step _ g = g -- TODO Do something with step? + step _ g = g -- TODO Do something with step? Check health etc. handleInputs = handleAllInput diff --git a/lib/control/Input.hs b/lib/RPGEngine/Input.hs similarity index 69% rename from lib/control/Input.hs rename to lib/RPGEngine/Input.hs index 30c6a6b..337a3bc 100644 --- a/lib/control/Input.hs +++ b/lib/RPGEngine/Input.hs @@ -1,21 +1,25 @@ -module Input -( --- Handle all input for RPG-Engine -handleAllInput +-- Input for RPG-Engine + +module RPGEngine.Input +( handleAllInput ) where -import Game -import State -import InputHandling +import RPGEngine.Internals.Data.Game +import RPGEngine.Internals.Data.State +import RPGEngine.Internals.Input import Graphics.Gloss.Interface.IO.Game ---------------------------------------------------------------------- +-- Handle all input for RPG-Engine handleAllInput :: InputHandler Game handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g handleAllInput ev g = handleAnyKey setNextState ev g +---------------------------------------------------------------------- + +-- Input for 'Playing' state handlePlayInputs :: InputHandler Game handlePlayInputs = composeInputHandlers [ handleKey (Char 'p') (\game -> game{ state = Pause }) @@ -25,3 +29,4 @@ handlePlayInputs = composeInputHandlers [ setNextState :: Game -> Game setNextState game = game{ state = newState } where newState = nextState $ state game + diff --git a/lib/data/Game.hs b/lib/RPGEngine/Internals/Data/Game.hs similarity index 79% rename from lib/data/Game.hs rename to lib/RPGEngine/Internals/Data/Game.hs index 3a07903..7aa8ef4 100644 --- a/lib/data/Game.hs +++ b/lib/RPGEngine/Internals/Data/Game.hs @@ -1,13 +1,12 @@ -- Representation of all the game's data -module Game -( Game(..) +module RPGEngine.Internals.Data.Game +( Game(..), --- Initialize the game -, initGame +initGame ) where -import State +import RPGEngine.Internals.Data.State ----------------------------- Constants ------------------------------ @@ -19,6 +18,7 @@ data Game = Game { ---------------------------------------------------------------------- +-- Initialize the game initGame :: Game initGame = Game { state = defaultState diff --git a/lib/data/Internals.hs b/lib/RPGEngine/Internals/Data/Internals.hs similarity index 69% rename from lib/data/Internals.hs rename to lib/RPGEngine/Internals/Data/Internals.hs index 68f1a8d..476772b 100644 --- a/lib/data/Internals.hs +++ b/lib/RPGEngine/Internals/Data/Internals.hs @@ -1,16 +1,22 @@ -- Represents an item in the game. -module Internals +module RPGEngine.Internals.Data.Internals ( Action(..) +, Condition(..) , Object(..) +, EntityId +, ItemId ) where ----------------------------- Constants ------------------------------ +type EntityId = String +type ItemId = String + data Object = Item { -- All fields are required -- Easy way to identify items - id :: String, + id :: ItemId, -- Horizontal coördinate in the level x :: Int, -- Vertical coördinate in the level @@ -22,14 +28,14 @@ data Object = -- infinite or a natural number useTimes :: Maybe Int, -- List of conditional actions when the player is standing on this object - actions :: [Action], + actions :: [([Condition], Action)], -- Interpretation depends on action with this object. value :: Maybe Int } | Entity { -- Required fields -- Easy way to identify items - id :: String, + id :: EntityId, -- Horizontal coördinate in the level x :: Int, -- Vertical coördinate in the level @@ -38,7 +44,7 @@ data Object = -- Short description of the object description :: String, -- List of conditional actions when the player is standing on this object - actions :: [Action], + actions :: [([Condition], Action)], -- Optional fields -- The direction of the item. e.g. a door has a direction. direction :: Maybe Direction, @@ -54,8 +60,18 @@ data Direction = North | West deriving (Show) -type Action = ([Condition], Event) +data Action = Leave + | RetrieveItem ItemId + | UseItem ItemId + | DecreaseHp EntityId ItemId + | IncreasePlayerHp ItemId + | Nothing + deriving (Show, Eq) -type Condition = Bool +data Condition = InventoryFull + | InventoryContains ItemId + | Not Condition + | AlwaysFalse + deriving (Show, Eq) -type Event = * \ No newline at end of file +---------------------------------------------------------------------- diff --git a/lib/data/Player.hs b/lib/RPGEngine/Internals/Data/Player.hs similarity index 77% rename from lib/data/Player.hs rename to lib/RPGEngine/Internals/Data/Player.hs index 642a6c3..c325df0 100644 --- a/lib/data/Player.hs +++ b/lib/RPGEngine/Internals/Data/Player.hs @@ -1,11 +1,11 @@ -- Represents a player in the game. This player can move around, pick -- up items and interact with the world. -module Player +module RPGEngine.Internals.Data.Player ( Player(..) ) where -import Internals +import RPGEngine.Internals.Data.Internals ----------------------------- Constants ------------------------------ diff --git a/lib/data/State.hs b/lib/RPGEngine/Internals/Data/State.hs similarity index 84% rename from lib/data/State.hs rename to lib/RPGEngine/Internals/Data/State.hs index 1ae7a29..b567517 100644 --- a/lib/data/State.hs +++ b/lib/RPGEngine/Internals/Data/State.hs @@ -2,12 +2,10 @@ -- e.g. Main menu, game, pause, win or lose -- Allows to easily go to a next state and change rendering accordingly -module State +module RPGEngine.Internals.Data.State ( State(..) --- Default state of the game, Menu , defaultState --- Get the next state based on the current state , nextState ) where @@ -20,13 +18,17 @@ data State = Menu | Win | Lose ----------------------------------------------------------------------- - +-- Default state of the game, Menu defaultState :: State defaultState = Menu +---------------------------------------------------------------------- + +-- Get the next state based on the current state nextState :: State -> State nextState Menu = Playing nextState Playing = Pause nextState Pause = Playing -nextState _ = Menu \ No newline at end of file +nextState _ = Menu + +---------------------------------------------------------------------- diff --git a/lib/control/InputHandling.hs b/lib/RPGEngine/Internals/Input.hs similarity index 84% rename from lib/control/InputHandling.hs rename to lib/RPGEngine/Internals/Input.hs index 1b4db4a..d74c6d6 100644 --- a/lib/control/InputHandling.hs +++ b/lib/RPGEngine/Internals/Input.hs @@ -1,18 +1,12 @@ -- Allows to create a massive inputHandler that can handle anything -- after you specify what you want it to do. -module InputHandling -( InputHandler(..), --- Compose multiple InputHandlers into one InputHandler that handles --- all of them. -composeInputHandlers, - --- Handle any event -handle, --- Handle a event by pressing a key -handleKey, --- Handle any key, equivalent to "Press any key to start" -handleAnyKey +module RPGEngine.Internals.Input +( InputHandler(..) +, composeInputHandlers +, handle +, handleKey +, handleAnyKey ) where import Graphics.Gloss.Interface.IO.Game @@ -23,20 +17,31 @@ type InputHandler a = Event -> (a -> a) ---------------------------------------------------------------------- +-- Compose multiple InputHandlers into one InputHandler that handles +-- all of them. composeInputHandlers :: [InputHandler a] -> InputHandler a composeInputHandlers [] ev a = a composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a) +-- Handle any event handle :: Event -> (a -> a) -> InputHandler a handle (EventKey key _ _ _) = handleKey key -- handle (EventMotion _) = undefined -- handle (EventResize _) = undefined -handle _ = (\_ -> (\_ -> id)) +handle _ = const (const id) +-- Handle a event by pressing a key handleKey :: Key -> (a -> a) -> InputHandler a handleKey (SpecialKey sk) = handleSpecialKey sk handleKey (Char c ) = handleCharKey c -handleKey (MouseButton _ ) = (\_ -> (\_ -> id)) +handleKey (MouseButton _ ) = const (const id) + +-- Handle any key, equivalent to "Press any key to start" +handleAnyKey :: (a -> a) -> InputHandler a +handleAnyKey f (EventKey _ Down _ _) = f +handleAnyKey _ _ = id + +---------------------------------------------------------------------- handleCharKey :: Char -> (a -> a) -> InputHandler a handleCharKey c1 f (EventKey (Char c2) Down _ _) @@ -49,7 +54,3 @@ handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _) | sk1 == sk2 = f | otherwise = id handleSpecialKey _ _ _ = id - -handleAnyKey :: (a -> a) -> InputHandler a -handleAnyKey f (EventKey _ Down _ _) = f -handleAnyKey _ _ = id diff --git a/lib/RPGEngine/Internals/Parse.hs b/lib/RPGEngine/Internals/Parse.hs new file mode 100644 index 0000000..1118d85 --- /dev/null +++ b/lib/RPGEngine/Internals/Parse.hs @@ -0,0 +1,20 @@ +module RPGEngine.Internals.Parse where + +import Text.Parsec +import Text.Parsec.String + +-- A wrapper, which takes a parser and some input and returns a +-- parsed output. +parseWith :: Parser a -> String -> Either ParseError a +parseWith parser = parse parser "" + +-- Also return anything that has not yet been parsed +parseWithRest :: Parser a -> String -> Either ParseError (a, String) +-- fmap (,) over Parser monad and apply to rest +parseWithRest parser = parse ((,) <$> parser <*> rest) "" + where rest = manyTill anyToken eof + +-- Ignore all kinds of whitespaces +ignoreWS :: Parser a -> Parser a +ignoreWS parser = choice [skipComment, spaces] >> parser + where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()} \ No newline at end of file diff --git a/lib/RPGEngine/Internals/Parse/StructureElement.hs b/lib/RPGEngine/Internals/Parse/StructureElement.hs new file mode 100644 index 0000000..f9955fd --- /dev/null +++ b/lib/RPGEngine/Internals/Parse/StructureElement.hs @@ -0,0 +1,161 @@ +module RPGEngine.Internals.Parse.StructureElement where + +import RPGEngine.Internals.Data.Internals (Action(..), Condition(..)) +import RPGEngine.Internals.Parse ( ignoreWS ) + +import Text.Parsec + ( char, + many, + try, + alphaNum, + digit, + noneOf, + oneOf, + between, + choice, + many1, + notFollowedBy, + sepBy ) +import qualified Text.Parsec as P ( string ) +import Text.Parsec.String ( Parser ) +import GHC.IO.Device (RawIO(readNonBlocking)) + +-------------------------- StructureElement -------------------------- + +-- See documentation for more details, only a short description is +-- provided here. +data StructureElement = Block [StructureElement] + | Entry Key StructureElement -- Key + Value + | Regular Value -- Regular value, Integer or String or Infinite + deriving (Show, Eq) + +---------------------------------------------------------------------- + +structureElement :: Parser StructureElement +structureElement = try $ choice [block, entry, regular] + +-- A list of entries +block :: Parser StructureElement +block = try $ do + open <- ignoreWS $ oneOf openingBrackets + middle <- ignoreWS entry `sepBy` ignoreWS (char ',') + let closingBracket = getMatchingClosingBracket open + ignoreWS $ char closingBracket + return $ Block middle + +entry :: Parser StructureElement +entry = try $ do + key <- ignoreWS key + -- TODO Fix this + oneOf ": " -- Can be left out + value <- ignoreWS structureElement + return $ Entry key value + +regular :: Parser StructureElement +regular = try $ Regular <$> value + +--------------------------------- Key -------------------------------- + +data Key = Tag String + | ConditionList [Condition] + deriving (Show, Eq) + +data ConditionArgument = ArgString String + | Condition Condition + deriving (Show, Eq) + +---------------------------------------------------------------------- + +key :: Parser Key +key = try $ choice [conditionList, tag] + +tag :: Parser Key +tag = try $ Tag <$> many1 alphaNum + +conditionList :: Parser Key +conditionList = try $ do + open <- ignoreWS $ oneOf openingBrackets + list <- try $ ignoreWS condition `sepBy` ignoreWS (char ',') + let closingBracket = getMatchingClosingBracket open + ignoreWS $ char closingBracket + return $ ConditionList $ extract list + where extract ((Condition cond):list) = cond:extract list + extract _ = [] + +condition :: Parser ConditionArgument +condition = try $ do + text <- ignoreWS $ many1 $ noneOf illegalCharacters + open <- ignoreWS $ oneOf openingBrackets + cond <- ignoreWS $ choice [condition, argString] + let closingBracket = getMatchingClosingBracket open + ignoreWS $ char closingBracket + return $ Condition $ make text cond + where make "inventoryFull" _ = InventoryFull + make "inventoryContains" (ArgString arg) = InventoryContains arg + make "not" (Condition cond) = Not cond + make _ _ = AlwaysFalse + argString = try $ ArgString <$> many (noneOf illegalCharacters) + +-------------------------------- Value ------------------------------- + +data Value = String String + | Integer Int + | Infinite + | Action Action + | Layout -- TODO Add element + deriving (Show, Eq) + +---------------------------------------------------------------------- + +value :: Parser Value +value = choice [string, integer, infinite, action] + +string :: Parser Value +string = try $ String <$> between (char '\"') (char '\"') reading + where reading = ignoreWS $ many1 $ noneOf illegalCharacters + +integer :: Parser Value +integer = try $ do + value <- ignoreWS $ many1 digit + return $ Integer (read value :: Int) + +infinite :: Parser Value +infinite = try $ do + ignoreWS $ P.string "infinite" + notFollowedBy alphaNum + return Infinite + +action :: Parser Value +action = try $ do + script <- ignoreWS $ many1 $ noneOf "(" + arg <- ignoreWS $ between (char '(') (char ')') $ many $ noneOf ")" + let answer | script == "leave" = Leave + | script == "retrieveItem" = RetrieveItem arg + | script == "useItem" = UseItem arg + | script == "decreaseHp" = DecreaseHp first second + | script == "increasePlayerHp" = IncreasePlayerHp arg + | otherwise = RPGEngine.Internals.Data.Internals.Nothing + (first, ',':second) = break (== ',') arg + return $ Action answer + +-- TODO +layout :: Parser Value +layout = undefined + +------------------------------ Brackets ------------------------------ + +openingBrackets :: [Char] +openingBrackets = "<({[" + +closingBrackets :: [Char] +closingBrackets = ">)}]" + +illegalCharacters :: [Char] +illegalCharacters = ",:\"" ++ openingBrackets ++ closingBrackets + +---------------------------------------------------------------------- + +getMatchingClosingBracket :: Char -> Char +getMatchingClosingBracket opening = closingBrackets !! index + where combo = zip openingBrackets [0 ..] + index = head $ [y | (x, y) <- combo, x == opening] \ No newline at end of file diff --git a/lib/RPGEngine/Parse.hs b/lib/RPGEngine/Parse.hs new file mode 100644 index 0000000..15d3458 --- /dev/null +++ b/lib/RPGEngine/Parse.hs @@ -0,0 +1,8 @@ +module RPGEngine.Parse where + +import RPGEngine.Internals.Data.Game + +-- TODO parseFromFile gebruiken + +parseToGame :: Game +parseToGame = undefined \ No newline at end of file diff --git a/lib/render/Render.hs b/lib/RPGEngine/Render.hs similarity index 63% rename from lib/render/Render.hs rename to lib/RPGEngine/Render.hs index a94fed5..e65d589 100644 --- a/lib/render/Render.hs +++ b/lib/RPGEngine/Render.hs @@ -1,23 +1,29 @@ -- Allows to render the played game -module Render -( --- Initialize a window to play in -initWindow +module RPGEngine.Render +( initWindow +, bgColor --- Render the game , render ) where -import Game(Game(..)) -import State(State(..)) +import RPGEngine.Internals.Data.Game(Game(..)) +import RPGEngine.Internals.Data.State(State(..)) import Graphics.Gloss +----------------------------- Constants ------------------------------ + +-- Game background color +bgColor :: Color +bgColor = white + ---------------------------------------------------------------------- +-- Initialize a window to play in initWindow :: String -> (Int, Int) -> (Int, Int) -> Display -initWindow title dims offs = InWindow title dims offs +initWindow = InWindow +-- Render the game render :: Game -> Picture render g@Game{ state = Menu } = renderMenu g render g@Game{ state = Playing } = renderPlaying g @@ -25,10 +31,11 @@ render g@Game{ state = Pause } = renderPause g render g@Game{ state = Win } = renderWin g render g@Game{ state = Lose } = renderLose g +---------------------------------------------------------------------- -- TODO renderMenu :: Game -> Picture -renderMenu _ = text "Menu" +renderMenu _ = text "[Press any key to start]" -- TODO renderPlaying :: Game -> Picture @@ -36,7 +43,7 @@ renderPlaying _ = text "Playing" -- TODO renderPause :: Game -> Picture -renderPause _ = text "Pause" +renderPause _ = text "[Press any key to continue]" -- TODO renderWin :: Game -> Picture diff --git a/lib/control/Parse.hs b/lib/control/Parse.hs deleted file mode 100644 index 376f29b..0000000 --- a/lib/control/Parse.hs +++ /dev/null @@ -1,132 +0,0 @@ -module Parse where - --- TODO Maak wrapper module --- TODO This module should not be used by anything except for wrapper module and tests - -import Game -import Player -import Text.Parsec -import Text.Parsec.Char -import Text.Parsec.String -import Data.List -import Data.Maybe -import Text.Parsec.Error (Message(UnExpect)) - --- TODO parseFromFile gebruiken - --- Parser type --- type Parser = Parsec String () - --- A wrapper, which takes a parser and some input and returns a --- parsed output. -parseWith :: Parser a -> String -> Either ParseError a -parseWith parser = parse parser "" - -ignoreWS :: Parser a -> Parser a -ignoreWS parser = spaces >> parser - --- Also return anything that has not yet been parsed -parseWithRest :: Parser a -> String -> Either ParseError (a, String) --- fmap (,) over Parser monad and apply to rest -parseWithRest parser = parse ((,) <$> parser <*> rest) "" - where rest = manyTill anyToken eof - -parseToGame :: Game -parseToGame = undefined - --- Info in between brackets, '(..)', '[..]', '{..}' or '<..>' -data Brackets a = Brackets a - deriving (Eq, Show) - -parseToPlayer :: Player -parseToPlayer = undefined - --- any words separated by whitespace -parseWord :: Parser String -parseWord = do many alphaNum - --- TODO Expand to allow different kinds of brackets, also see Brackets data type. --- TODO Check if brackets match order. --- TODO Allow nested brackets. -brackets :: Parser (Brackets String) -brackets = do - ignoreWS $ char '(' - e <- ignoreWS $ many1 alphaNum - ignoreWS $ char ')' - return $ Brackets e - ------------------------- - -data Value = String String - | Integer Int - | Infinite - deriving (Show, Eq) - --- See documentation for more details, only a short description is ---provided here. -data StructureElement = Block [StructureElement] - | Entry String StructureElement-- Key + Value - | Regular Value -- Regular value, Integer or String or Infinite - | ConditionList [StructureElement] - -- TODO - | Condition -- inventoryFull() etc. - -- TODO - | Action -- leave(), useItem(objectId) etc. - deriving (Show, Eq) - --- TODO Add ConditionList and Action -structureElement :: Parser StructureElement -structureElement = choice [block, regular] - --- A Block is a list of Entry s -block :: Parser StructureElement -block = do - ignoreWS $ char '{' - list <- ignoreWS $ many1 entry - ignoreWS $ char '}' - return $ Block list - -entry :: Parser StructureElement -entry = do - key <- ignoreWS $ many1 alphaNum - ignoreWS $ char ':' - value <- ignoreWS structureElement -- TODO Is this the correct one to use? - return $ Entry key value - -regular :: Parser StructureElement -regular = do - value <- ignoreWS $ choice [integer, valueString, infinite] - return $ Regular value - -integer :: Parser Value -integer = do - value <- ignoreWS $ many1 digit - return $ Integer (read value :: Int) - -valueString :: Parser Value -valueString = do - ignoreWS $ char '"' - value <- ignoreWS $ many1 (noneOf ['"']) - ignoreWS $ char '"' - return $ String value - -infinite :: Parser Value -infinite = do - ignoreWS $ string "infinite" - notFollowedBy alphaNum - return Infinite - -conditionList :: Parser StructureElement -conditionList = do - ignoreWS $ char '[' - list <- ignoreWS $ many1 condition - ignoreWS $ char ']' - return $ ConditionList list - --- TODO -condition :: Parser StructureElement -condition = undefined - --- TODO YOU ARE HERE -action :: Parser StructureElement -action = undefined diff --git a/rpg-engine.cabal b/rpg-engine.cabal index 3775de7..bc85730 100644 --- a/rpg-engine.cabal +++ b/rpg-engine.cabal @@ -5,19 +5,25 @@ cabal-version: 1.12 build-type: Simple library - hs-source-dirs: lib, lib/control, lib/data, lib/render + hs-source-dirs: lib build-depends: base >= 4.7 && <5, gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3, parsec >= 3.1.15.1 exposed-modules: - RPGEngine, - -- Control - Input, InputHandling, Parse, - -- Data - Game, Internals, Player, State, - -- Render - Render + RPGEngine + + RPGEngine.Input + RPGEngine.Parse + RPGEngine.Render + + RPGEngine.Internals.Data.Game + RPGEngine.Internals.Data.Internals + RPGEngine.Internals.Data.Player + RPGEngine.Internals.Data.State + RPGEngine.Internals.Input + RPGEngine.Internals.Parse + RPGEngine.Internals.Parse.StructureElement executable rpg-engine main-is: Main.hs diff --git a/stack.yaml b/stack.yaml index 344fbba..2f59104 100644 --- a/stack.yaml +++ b/stack.yaml @@ -67,3 +67,5 @@ extra-deps: # # Allow a newer minor version of GHC than the snapshot specifies # compiler-check: newer-minor + +custom-preprocessor-extensions: [] \ No newline at end of file diff --git a/test/ParsedToGameSpec.hs b/test/ParsedToGameSpec.hs index b1d3930..9a6aec6 100644 --- a/test/ParsedToGameSpec.hs +++ b/test/ParsedToGameSpec.hs @@ -1,7 +1,7 @@ module ParsedToGameSpec where import Test.Hspec -import Parse +import RPGEngine.Internals.Parse.StructureElement spec :: Spec spec = do diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs index b5db0cc..301b282 100644 --- a/test/ParserSpec.hs +++ b/test/ParserSpec.hs @@ -1,7 +1,9 @@ module ParserSpec where import Test.Hspec -import Parse +import RPGEngine.Internals.Parse +import RPGEngine.Internals.Parse.StructureElement +import RPGEngine.Internals.Data.Internals import Data.Either spec :: Spec @@ -9,40 +11,118 @@ spec = do describe "Basics of entries" $ do it "can parse integers" $ do let correct = Right $ Regular $ Integer 1 - correct `shouldBe` parseWith regular "1" + parseWith regular "1" `shouldBe` correct it "can parse string" $ do let input = "dit is een string" correct = Right $ Regular $ String input - correct `shouldBe` parseWith regular ("\"" ++ input ++ "\"") + parseWith regular ("\"" ++ input ++ "\"") `shouldBe` correct it "can parse infinite" $ do let correct = Right $ Regular Infinite - correct `shouldBe` parseWith regular "infinite" + parseWith regular "infinite" `shouldBe` correct let wrong = Right $ Regular Infinite - wrong `shouldNotBe` parseWith regular "infinitee" + parseWith regular "infinitee" `shouldNotBe` wrong it "can parse entries" $ do - let input = "id : \"dagger\"" - correct = Right $ Entry "id" $ Regular $ String "dagger" - correct `shouldBe` parseWith entry input + let input = "id: \"dagger\"" + correct = Right $ Entry (Tag "id") $ Regular $ String "dagger" + parseWith entry input `shouldBe` correct let input = "x: 0" - correct = Right $ Entry "x" $ Regular $ Integer 0 - correct `shouldBe` parseWith entry input + correct = Right $ Entry (Tag "x") $ Regular $ Integer 0 + parseWith entry input `shouldBe` correct let input = "useTimes: infinite" - correct = Right $ Entry "useTimes" $ Regular Infinite - correct `shouldBe` parseWith entry input + correct = Right $ Entry (Tag "useTimes") $ Regular Infinite + parseWith entry input `shouldBe` correct - describe "Special kinds" $ do + describe "block: {...}" $ do + it "can parse a block with a single entry" $ do + let input = "{ id: 1}" + correct = Right (Block [ + Entry (Tag "id") $ Regular $ Integer 1 + ], "") + parseWithRest structureElement input `shouldBe` correct + + it "can parse a block with entries" $ do + let input = "{ id: \"key\", x: 3, y: 1}" + correct = Right $ Block [ + Entry (Tag "id") $ Regular $ String "key", + Entry (Tag "x") $ Regular $ Integer 3, + Entry (Tag "y") $ Regular $ Integer 1 + ] + parseWith structureElement input `shouldBe` correct + + describe "Basics" $ do + it "can parse leave()" $ do + let input = "leave()" + correct = Right $ Action Leave + parseWith action input `shouldBe` correct + + it "can parse retrieveItem()" $ do + let input = "retrieveItem(firstId)" + correct = Right $ Action $ RetrieveItem "firstId" + parseWith action input `shouldBe` correct + + it "can parse useItem()" $ do + let input = "useItem(secondId)" + correct = Right $ Action $ UseItem "secondId" + parseWith action input `shouldBe` correct + + it "can parse decreaseHp()" $ do + let input = "decreaseHp(entityId,objectId)" + correct = Right $ Action $ DecreaseHp "entityId" "objectId" + parseWith action input `shouldBe` correct + + it "can parse increasePlayerHp()" $ do + let input = "increasePlayerHp(objectId)" + correct = Right $ Action $ IncreasePlayerHp "objectId" + parseWith action input `shouldBe` correct + + it "can parse inventoryFull()" $ do + let input = "inventoryFull()" + correct = Right (Condition InventoryFull, "") + parseWithRest condition input `shouldBe` correct + + it "can parse inventoryContains()" $ do + let input = "inventoryContains(itemId)" + correct = Right (Condition $ InventoryContains "itemId", "") + parseWithRest condition input `shouldBe` correct + + it "can parse not()" $ do + let input = "not(inventoryFull())" + correct = Right (Condition $ Not InventoryFull, "") + parseWithRest condition input `shouldBe` correct + + let input = "not(inventoryContains(itemId))" + correct = Right (Condition $ Not $ InventoryContains "itemId", "") + parseWithRest condition input `shouldBe` correct + + it "can parse conditionlists" $ do + let input = "[not(inventoryFull())]" + correct = Right (ConditionList [Not InventoryFull], "") + parseWithRest conditionList input `shouldBe` correct + + let input = "[inventoryFull(), inventoryContains(itemId)]" + correct = Right (ConditionList [ + InventoryFull, + InventoryContains "itemId" + ], "") + parseWithRest conditionList input `shouldBe` correct + + let input = "[]" + correct = Right $ ConditionList [] + parseWith conditionList input `shouldBe` correct + it "can parse actions" $ do - let input = "actions: {}" - correct = Right $ Entry "actions" $ Regular Infinite -- TODO Change this - correct `shouldBe` parseWith action input - - it "can parse conditions" $ do - pending - + let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}" + correct = Right (Entry (Tag "actions") $ Block [ + Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key", + Entry (ConditionList []) $ Regular $ Action Leave + ], "") + parseWithRest structureElement input `shouldBe` correct + + describe "Layouts" $ do it "can parse layouts" $ do pending