diff --git a/lib/RPGEngine.hs b/lib/RPGEngine.hs index ee52fc9..f9372e7 100644 --- a/lib/RPGEngine.hs +++ b/lib/RPGEngine.hs @@ -5,7 +5,7 @@ module RPGEngine ( playRPGEngine ) where -import RPGEngine.Data.Game +import RPGEngine.Data.Defaults import RPGEngine.Render import RPGEngine.Input diff --git a/lib/RPGEngine/Data.hs b/lib/RPGEngine/Data.hs index b91b7f2..13be117 100644 --- a/lib/RPGEngine/Data.hs +++ b/lib/RPGEngine/Data.hs @@ -16,7 +16,7 @@ data Level = Level { layout :: Layout, items :: [Item], entities :: [Entity] -} +} deriving (Eq, Show) type Layout = [Strip] type Strip = [Physical] @@ -26,14 +26,14 @@ data Physical = Void | Blocked | Entrance | Exit - deriving (Show, Eq) + deriving (Eq, Show) ------------------------------- Player ------------------------------- data Player = Player { playerHp :: Maybe Int, inventory :: [Item] -} +} deriving (Eq, Show) instance Living Player where hp = playerHp @@ -70,7 +70,7 @@ data Item = Item { itemActions :: [([Condition], Action)], itemValue :: Maybe Int, useTimes :: Maybe Int -} +} deriving (Eq, Show) instance Object Item where id = itemId @@ -90,8 +90,8 @@ data Entity = Entity { entityActions :: [([Condition], Action)], entityValue :: Maybe Int, entityHp :: Maybe Int, - direction :: Maybe Direction -} + direction :: Direction +} deriving (Eq, Show) instance Object Entity where id = entityId diff --git a/lib/RPGEngine/Data/Defaults.hs b/lib/RPGEngine/Data/Defaults.hs new file mode 100644 index 0000000..2ef92f2 --- /dev/null +++ b/lib/RPGEngine/Data/Defaults.hs @@ -0,0 +1,60 @@ +module RPGEngine.Data.Defaults where + +import RPGEngine.Data + +defaultEntity :: Entity +defaultEntity = Entity { + entityId = "", + entityX = 0, + entityY = 0, + entityName = "Default", + entityDescription = "", + entityActions = [], + entityValue = Prelude.Nothing, + entityHp = Prelude.Nothing, + direction = Center +} + +-- Initialize the game +initGame :: Game +initGame = Game { + state = defaultState, + playing = defaultLevel, + levels = [defaultLevel] +} + +defaultItem :: Item +defaultItem = Item { + itemId = "", + itemX = 0, + itemY = 0, + itemName = "Default", + itemDescription = "", + itemActions = [], + itemValue = Prelude.Nothing, + useTimes = Prelude.Nothing +} + +defaultLayout :: Layout +defaultLayout = [ + [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], + [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked], + [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] + ] + +defaultLevel :: Level +defaultLevel = Level { + layout = defaultLayout, + items = [], + entities = [] +} + +defaultPlayer :: Player +defaultPlayer = Player { + playerHp = Prelude.Nothing, -- Compares to infinity + inventory = [] +} + +-- Default state of the game, Menu +defaultState :: State +defaultState = Menu \ No newline at end of file diff --git a/lib/RPGEngine/Data/Game.hs b/lib/RPGEngine/Data/Game.hs deleted file mode 100644 index 82750f6..0000000 --- a/lib/RPGEngine/Data/Game.hs +++ /dev/null @@ -1,25 +0,0 @@ --- Representation of all the game's data - -module RPGEngine.Data.Game -( Game(..) - ,initGame -) where - -import RPGEngine.Data -import RPGEngine.Data.State - ----------------------------------------------------------------------- - --- Initialize the game -initGame :: Game -initGame = Game { - state = defaultState, - playing = head levels, - levels = levels -} - where levels = [emptyLevel] - emptyLevel = Level { - layout = [], - items = [], - entities = [] - } diff --git a/lib/RPGEngine/Data/State.hs b/lib/RPGEngine/Data/State.hs index 42d9d3f..057bc9e 100644 --- a/lib/RPGEngine/Data/State.hs +++ b/lib/RPGEngine/Data/State.hs @@ -4,19 +4,12 @@ module RPGEngine.Data.State ( State(..) -, defaultState , nextState ) where import RPGEngine.Data ------------------------------ Constants ------------------------------ - --- Default state of the game, Menu -defaultState :: State -defaultState = Menu - ---------------------------------------------------------------------- -- Get the next state based on the current state diff --git a/lib/RPGEngine/Parse.hs b/lib/RPGEngine/Parse.hs index f5838d3..a8736ad 100644 --- a/lib/RPGEngine/Parse.hs +++ b/lib/RPGEngine/Parse.hs @@ -1,7 +1,7 @@ module RPGEngine.Parse where import RPGEngine.Data -import RPGEngine.Parse.StructureElement +import RPGEngine.Parse.StructElement import RPGEngine.Parse.Game import Text.Parsec.String @@ -14,6 +14,6 @@ type FileName = String ---------------------------------------------------------------------- parseToGame :: FileName -> Game -parseToGame filename = structureToGame structure - where (Right structure) = unsafePerformIO io - io = parseFromFile structureElement filename \ No newline at end of file +parseToGame filename = structToGame struct + where (Right struct) = unsafePerformIO io + io = parseFromFile structElement filename \ No newline at end of file diff --git a/lib/RPGEngine/Parse/Game.hs b/lib/RPGEngine/Parse/Game.hs index 85028f2..9999ffd 100644 --- a/lib/RPGEngine/Parse/Game.hs +++ b/lib/RPGEngine/Parse/Game.hs @@ -1,22 +1,101 @@ module RPGEngine.Parse.Game where import RPGEngine.Data -import RPGEngine.Parse.StructureElement (StructureElement) +import RPGEngine.Data.Defaults +import RPGEngine.Parse.StructElement -------------------------------- Game -------------------------------- -- TODO -structureToGame :: StructureElement -> Game -structureToGame = undefined +structToGame :: StructElement -> Game +structToGame = undefined ------------------------------- Player ------------------------------- --- TODO -structureToPlayer :: StructureElement -> Player -structureToPlayer = undefined +structToPlayer :: StructElement -> Player +structToPlayer (Block block) = structToPlayer' block defaultPlayer +structToPlayer _ = defaultPlayer + +structToPlayer' :: [StructElement] -> Player -> Player +structToPlayer' [] p = p +structToPlayer' ((Entry(Tag "hp") val ):es) p = (structToPlayer' es p){ playerHp = structToMaybeInt val } +structToPlayer' ((Entry(Tag "inventory") (Block inv)):es) p = (structToPlayer' es p){ inventory = structToItems inv } +structToPlayer' _ _ = defaultPlayer + +structToActions :: StructElement -> [([Condition], Action)] +structToActions (Block []) = [] +structToActions (Block block) = structToActions' block [] +structToActions _ = [] + +structToActions' :: [StructElement] -> [([Condition], Action)] -> [([Condition], Action)] +structToActions' [] list = list +structToActions' ((Entry(ConditionList cs) (Regular (Action a))):as) list = structToActions' as ((cs, a):list) +structToActions' _ list = list ------------------------------- Levels ------------------------------- --- TODO -structureToLevels :: StructureElement -> [Level] -structureToLevels = undefined \ No newline at end of file +structToLevels :: StructElement -> [Level] +structToLevels (Block struct) = structToLevel <$> struct +structToLevels _ = [defaultLevel] + +structToLevel :: StructElement -> Level +structToLevel (Block entries) = structToLevel' entries defaultLevel +structToLevel _ = defaultLevel + +structToLevel' :: [StructElement] -> Level -> Level +structToLevel' ((Entry(Tag "layout") (Regular (Layout layout))):ls) l = (structToLevel' ls l){ RPGEngine.Data.layout = layout } +structToLevel' ((Entry(Tag "items") (Block items) ):ls) l = (structToLevel' ls l){ items = structToItems items } +structToLevel' ((Entry(Tag "entities") (Block entities) ):ls) l = (structToLevel' ls l){ entities = structToEntities entities } +structToLevel' _ _ = defaultLevel + +------------------------------- Items -------------------------------- + +structToItems :: [StructElement] -> [Item] +structToItems items = structToItem <$> items + +structToItem :: StructElement -> Item +structToItem (Block block) = structToItem' block defaultItem +structToItem _ = defaultItem + +structToItem' :: [StructElement] -> Item -> Item +structToItem' [] i = i +structToItem' ((Entry(Tag "id") (Regular(String id ))):is) i = (structToItem' is i){ itemId = id } +structToItem' ((Entry(Tag "x") (Regular(Integer x ))):is) i = (structToItem' is i){ itemX = x } +structToItem' ((Entry(Tag "y") (Regular(Integer y ))):is) i = (structToItem' is i){ itemY = y } +structToItem' ((Entry(Tag "name") (Regular(String name))):is) i = (structToItem' is i){ itemName = name } +structToItem' ((Entry(Tag "description") (Regular(String desc))):is) i = (structToItem' is i){ itemDescription = desc } +structToItem' ((Entry(Tag "value") val ):is) i = (structToItem' is i){ itemValue = structToMaybeInt val } +structToItem' ((Entry(Tag "actions") actions ):is) i = (structToItem' is i){ itemActions = structToActions actions } +structToItem' ((Entry (Tag "useTimes") useTimes ):is) i = (structToItem' is i){ useTimes = structToMaybeInt useTimes } +structToItem' _ _ = defaultItem + +------------------------------ Entities ------------------------------ + +structToEntities :: [StructElement] -> [Entity] +structToEntities entities = structToEntity <$> entities + +structToEntity :: StructElement -> Entity +structToEntity (Block block) = structToEntity' block defaultEntity +structToEntity _ = defaultEntity + +structToEntity' :: [StructElement] -> Entity -> Entity +structToEntity' [] e = e +structToEntity' ((Entry(Tag "id") (Regular(String id )) ):es) e = (structToEntity' es e){ entityId = id } +structToEntity' ((Entry(Tag "x") (Regular(Integer x )) ):es) e = (structToEntity' es e){ entityX = x } +structToEntity' ((Entry(Tag "y") (Regular(Integer y )) ):es) e = (structToEntity' es e){ entityY = y } +structToEntity' ((Entry(Tag "name") (Regular(String name)) ):es) e = (structToEntity' es e){ entityName = name } +structToEntity' ((Entry(Tag "description") (Regular(String desc)) ):es) e = (structToEntity' es e){ entityDescription = desc } +structToEntity' ((Entry(Tag "actions") actions ):es) e = (structToEntity' es e){ entityActions = structToActions actions } +structToEntity' ((Entry(Tag "value") val ):es) e = (structToEntity' es e){ entityValue = structToMaybeInt val } +structToEntity' ((Entry(Tag "hp") val ):es) e = (structToEntity' es e){ entityHp = structToMaybeInt val } +structToEntity' ((Entry(Tag "direction") (Regular(Direction dir))):es) e = (structToEntity' es e){ RPGEngine.Data.direction = dir } +structToEntity' _ _ = defaultEntity + +---------------------------------------------------------------------- + +structToMaybeInt :: StructElement -> Maybe Int +structToMaybeInt (Regular (Integer val)) = Just val +structToMaybeInt (Regular Infinite) = Prelude.Nothing +structToMaybeInt _ = Prelude.Nothing -- TODO + +---------------------------------------------------------------------- \ No newline at end of file diff --git a/lib/RPGEngine/Parse/StructureElement.hs b/lib/RPGEngine/Parse/StructElement.hs similarity index 89% rename from lib/RPGEngine/Parse/StructureElement.hs rename to lib/RPGEngine/Parse/StructElement.hs index ce5d8c5..35d2b08 100644 --- a/lib/RPGEngine/Parse/StructureElement.hs +++ b/lib/RPGEngine/Parse/StructElement.hs @@ -1,4 +1,4 @@ -module RPGEngine.Parse.StructureElement where +module RPGEngine.Parse.StructElement where import RPGEngine.Data (Action(..), Condition(..), Layout, Direction(..), Physical(..), Strip) import RPGEngine.Parse.Core ( ignoreWS ) @@ -18,24 +18,23 @@ import Text.Parsec 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) +data StructElement = Block [StructElement] + | Entry Key StructElement -- Key + Value + | Regular Value -- Regular value, Integer or String or Infinite + deriving (Eq, Show) ---------------------------------------------------------------------- -structureElement :: Parser StructureElement -structureElement = try $ choice [block, entry, regular] +structElement :: Parser StructElement +structElement = try $ choice [block, entry, regular] -- A list of entries -block :: Parser StructureElement +block :: Parser StructElement block = try $ do open <- ignoreWS $ oneOf openingBrackets middle <- ignoreWS $ choice [entry, block] `sepBy` char ',' @@ -43,26 +42,26 @@ block = try $ do ignoreWS $ char closingBracket return $ Block middle -entry :: Parser StructureElement +entry :: Parser StructElement entry = try $ do key <- ignoreWS key -- TODO Fix this oneOf ": " -- Can be left out - value <- ignoreWS structureElement + value <- ignoreWS structElement return $ Entry key value -regular :: Parser StructureElement +regular :: Parser StructElement regular = try $ Regular <$> value --------------------------------- Key -------------------------------- data Key = Tag String | ConditionList [Condition] - deriving (Show, Eq) + deriving (Eq, Show) data ConditionArgument = ArgString String | Condition Condition - deriving (Show, Eq) + deriving (Eq, Show) ---------------------------------------------------------------------- @@ -104,7 +103,7 @@ data Value = String String | Action Action | Direction Direction | Layout Layout - deriving (Show, Eq) + deriving (Eq, Show) ---------------------------------------------------------------------- diff --git a/rpg-engine.cabal b/rpg-engine.cabal index f6a304b..0823b23 100644 --- a/rpg-engine.cabal +++ b/rpg-engine.cabal @@ -14,7 +14,7 @@ library RPGEngine RPGEngine.Data - RPGEngine.Data.Game + RPGEngine.Data.Defaults RPGEngine.Data.State RPGEngine.Input @@ -23,7 +23,7 @@ library RPGEngine.Parse RPGEngine.Parse.Core RPGEngine.Parse.Game - RPGEngine.Parse.StructureElement + RPGEngine.Parse.StructElement RPGEngine.Render @@ -41,4 +41,4 @@ test-suite rpg-engine-test build-depends: base >=4.7 && <5, hspec <= 2.10.6, hspec-discover, rpg-engine other-modules: -- Parsing - ParseGameSpec, ParseStructureElementSpec + ParseGameSpec, ParseStructElementSpec diff --git a/test/ParseGameSpec.hs b/test/ParseGameSpec.hs index a162246..2a2d7d2 100644 --- a/test/ParseGameSpec.hs +++ b/test/ParseGameSpec.hs @@ -1,7 +1,10 @@ module ParseGameSpec where import Test.Hspec -import RPGEngine.Parse.StructureElement +import RPGEngine.Parse.StructElement +import RPGEngine.Data +import RPGEngine.Parse.Core +import RPGEngine.Parse.Game spec :: Spec spec = do @@ -14,39 +17,118 @@ spec = do pending describe "Player" $ do - it "TODO: Simple player" $ do - pending + it "cannot die" $ do + let input = "player: { hp: infinite, inventory: [] }" + correct = Player { + playerHp = Prelude.Nothing, + inventory = [] + } + Right (Entry (Tag "player") struct) = parseWith structElement input + structToPlayer struct `shouldBe` correct + + it "without inventory" $ do + let input = "player: { hp: 50, inventory: [] }" + correct = Player { + playerHp = Just 50, + inventory = [] + } + Right (Entry (Tag "player") struct) = parseWith structElement input + structToPlayer struct `shouldBe` correct + + it "with inventory" $ do + let input = "player: { hp: 50, inventory: [ { id: \"dagger\", x: 0, y: 0, name: \"Dolk\", description: \"Basis schade tegen monsters\", useTimes: infinite, value: 10, actions: {} } ] }" + correct = Player { + playerHp = Just 50, + inventory = [ + Item { + itemId = "dagger", + itemX = 0, + itemY = 0, + itemName = "Dolk", + itemDescription = "Basis schade tegen monsters", + itemActions = [], + itemValue = Just 10, + useTimes = Prelude.Nothing + } + ] + } + Right (Entry (Tag "player") struct) = parseWith structElement input + structToPlayer struct `shouldBe` correct - describe "Inventory" $ do - it "TODO: Empty inventory" $ do + describe "Layout" $ do + it "simple" $ do pending - it "TODO: Singleton inventory" $ do - pending - it "TODO: Filled inventory" $ do - pending - + describe "Items" $ do - it "TODO: Simple item" $ do - pending - -- Check id - -- Check x - -- Check y - -- Check name - -- Check description - -- Check useTimes - -- Check value - -- Check actions + it "simple" $ do + let input = "{ id: \"dagger\", x: 0, y: 0, name: \"Dagger\", description: \"Basic dagger you found somewhere\", useTimes: infinite, value: 10, actions: {} }" + correct = Item { + itemId = "dagger", + itemX = 0, + itemY = 0, + itemName = "Dagger", + itemDescription = "Basic dagger you found somewhere", + itemValue = Just 10, + itemActions = [], + useTimes = Prelude.Nothing + } + Right struct = parseWith structElement input + structToItem struct `shouldBe` correct + + it "with actions" $ do + let input = "{ id: \"key\", x: 3, y: 1, name: \"Doorkey\", description: \"Unlocks a secret door\", useTimes: 1, value: 0, actions: { [not(inventoryFull())] retrieveItem(key), [] leave() } }" + correct = Item { + itemId = "key", + itemX = 3, + itemY = 1, + itemName = "Doorkey", + itemDescription = "Unlocks a secret door", + itemActions = [ + ([], Leave), + ([Not InventoryFull], RetrieveItem "key") + ], + itemValue = Just 0, + useTimes = Just 1 + } + Right struct = parseWith structElement input + structToItem struct `shouldBe` correct describe "Actions" $ do - it "TODO: Simple action" $ do - pending - + it "no conditions" $ do + let input = "{[] leave()}" + correct = [([], Leave)] + Right struct = parseWith structElement input + structToActions struct `shouldBe` correct + + it "single condition" $ do + let input = "{ [inventoryFull()] useItem(itemId)}" + correct = [([InventoryFull], UseItem "itemId")] + Right struct = parseWith structElement input + structToActions struct `shouldBe` correct + + it "multiple conditions" $ do + let input = "{ [not(inventoryFull()), inventoryContains(itemId)] increasePlayerHp(itemId)}" + correct = [([Not InventoryFull, InventoryContains "itemId"], IncreasePlayerHp "itemId")] + Right struct = parseWith structElement input + structToActions struct `shouldBe` correct + describe "Entities" $ do it "TODO: Simple entity" $ do pending describe "Level" $ do - it "TODO: Simple layout" $ do - pending + it "Simple layout" $ do + let input = "{ layout: { | * * * * * * \n| * s . . e *\n| * * * * * *\n}, items: [], entities: [] }" + correct = Level { + RPGEngine.Data.layout = [ + [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], + [Blocked, Entrance, Walkable, Walkable, Exit, Blocked], + [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] + ], + items = [], + entities = [] + } + Right struct = parseWith structElement input + structToLevel struct `shouldBe` correct it "TODO: Complex layout" $ do pending \ No newline at end of file diff --git a/test/ParseStructureElementSpec.hs b/test/ParseStructElementSpec.hs similarity index 91% rename from test/ParseStructureElementSpec.hs rename to test/ParseStructElementSpec.hs index bc70837..0f7464a 100644 --- a/test/ParseStructureElementSpec.hs +++ b/test/ParseStructElementSpec.hs @@ -1,10 +1,10 @@ -module ParseStructureElementSpec where +module ParseStructElementSpec where import Test.Hspec import RPGEngine.Data import RPGEngine.Parse.Core -import RPGEngine.Parse.StructureElement +import RPGEngine.Parse.StructElement spec :: Spec spec = do @@ -12,21 +12,21 @@ spec = do it "can parse blocks" $ do let input = "{}" correct = Right $ Block [] - parseWith structureElement input `shouldBe` correct + parseWith structElement input `shouldBe` correct let input = "{{}}" correct = Right $ Block [Block []] - parseWith structureElement input `shouldBe` correct + parseWith structElement input `shouldBe` correct let input = "{{}, {}}" correct = Right $ Block [Block [], Block []] - parseWith structureElement input `shouldBe` correct + parseWith structElement input `shouldBe` correct let input = "{ id: 1 }" correct = Right (Block [ Entry (Tag "id") $ Regular $ Integer 1 ], "") - parseWithRest structureElement input `shouldBe` correct + parseWithRest structElement input `shouldBe` correct let input = "{ id: \"key\", x: 3, y: 1}" correct = Right $ Block [ @@ -34,14 +34,14 @@ spec = do Entry (Tag "x") $ Regular $ Integer 3, Entry (Tag "y") $ Regular $ Integer 1 ] - parseWith structureElement input `shouldBe` correct + parseWith structElement input `shouldBe` correct 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 + parseWithRest structElement input `shouldBe` correct let input = "entities: [ { id: \"door\", x: 4, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left, y: 1}]" correct = Right (Entry (Tag "entities") $ Block [ Block [ @@ -52,7 +52,7 @@ spec = do Entry (Tag "direction") $ Regular $ Direction West, Entry (Tag "y") $ Regular $ Integer 1 ]], "") - parseWithRest structureElement input `shouldBe` correct + parseWithRest structElement input `shouldBe` correct let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]" correct = Right (Entry (Tag "entities") $ Block [ Block [ @@ -66,7 +66,7 @@ spec = do Entry (ConditionList []) $ Regular $ Action Leave ] ]], "") - parseWithRest structureElement input `shouldBe` correct + parseWithRest structElement input `shouldBe` correct let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left , actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]" correct = Right (Entry (Tag "entities") $ Block [ Block [ @@ -81,7 +81,7 @@ spec = do Entry (ConditionList []) $ Regular $ Action Leave ] ]], "") - parseWithRest structureElement input `shouldBe` correct + parseWithRest structElement input `shouldBe` correct it "can parse entries" $ do let input = "id: \"dagger\"" @@ -105,7 +105,7 @@ spec = do Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key", Entry (ConditionList []) $ Regular $ Action Leave ], "") - parseWithRest structureElement input `shouldBe` correct + parseWithRest structElement input `shouldBe` correct it "can parse regulars" $ do let input = "this is a string" @@ -237,19 +237,19 @@ spec = do it "can parse directions" $ do let input = "up" correct = Right $ Direction North - parseWith RPGEngine.Parse.StructureElement.direction input `shouldBe` correct + parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct let input = "right" correct = Right $ Direction East - parseWith RPGEngine.Parse.StructureElement.direction input `shouldBe` correct + parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct let input = "down" correct = Right $ Direction South - parseWith RPGEngine.Parse.StructureElement.direction input `shouldBe` correct + parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct let input = "left" correct = Right $ Direction West - parseWith RPGEngine.Parse.StructureElement.direction input `shouldBe` correct + parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct it "can parse layouts" $ do let input = "| * * * * * * * *\n| * s . . . . e *\n| * * * * * * * *" @@ -258,7 +258,7 @@ spec = do [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked], [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] ] - parseWith RPGEngine.Parse.StructureElement.layout input `shouldBe` correct + parseWith RPGEngine.Parse.StructElement.layout input `shouldBe` correct describe "Brackets" $ do it "matches closing <" $ do