#18 & massive structure overhaul

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]