161 lines
No EOL
5.1 KiB
Haskell
161 lines
No EOL
5.1 KiB
Haskell
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] |