module RPGEngine.Parse.TextToStructure
-- Everything is exported for testing
where

import RPGEngine.Parse.Core ( ignoreWS )

import RPGEngine.Data (Action (..), Condition (..), Direction (..), Layout, Strip, Physical (..))

import Text.Parsec
    ( alphaNum,
      char,
      digit,
      noneOf,
      oneOf,
      between,
      choice,
      many1,
      notFollowedBy,
      sepBy,
      many,
      try, spaces, endOfLine )
import qualified Text.Parsec as P ( string )
import Text.Parsec.String ( Parser )
import Text.Parsec.Combinator (lookAhead)

gameFile :: Parser [Structure]
gameFile = try $ do many1 $ ignoreWS structure

-------------------------- StructureElement --------------------------

-- See documentation for more details, only a short description is
-- provided here.
data Structure = Block [Structure]
               | Entry Key Structure -- Key + Value
               | Regular Value -- Regular value, Integer or String or Infinite
               deriving (Eq, Show)

----------------------------------------------------------------------

structure :: Parser Structure
structure = try $ choice [block, entry, regular]

-- A list of entries
block :: Parser Structure
block = try $ do
    open   <- ignoreWS $ oneOf openingBrackets
    middle <- ignoreWS $ choice [entry, block] `sepBy` char ','
    let closingBracket = getMatchingClosingBracket open
    ignoreWS $ char closingBracket
    return $ Block middle

entry :: Parser Structure
entry = try $ do
    key <- ignoreWS key
    -- TODO Fix this
    oneOf ": " --  Can be left out
    value <- ignoreWS structure
    return $ Entry key value

regular :: Parser Structure
regular = try $ Regular <$> value

--------------------------------- Key --------------------------------

data Key = Tag String
         | ConditionList [Condition]
         deriving (Eq, Show)

data ConditionArgument = ArgString String
                       | Condition Condition
                       deriving (Eq, Show)

----------------------------------------------------------------------

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 <- ignoreWS condition `sepBy` 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
           | Direction Direction
           | Layout Layout
           deriving (Eq, Show)

----------------------------------------------------------------------

value :: Parser Value
value = choice [layout, string, integer, infinite, direction, 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 (filter (/= ' ') second) -- TODO Work this hack away
               | script == "increasePlayerHp" = IncreasePlayerHp arg
               | otherwise                    = DoNothing
        (first, ',':second) = break (== ',') arg
    return $ Action answer

direction :: Parser Value
direction = try $ do
    value <- choice [
        ignoreWS $ P.string "up",
        ignoreWS $ P.string "down",
        ignoreWS $ P.string "left",
        ignoreWS $ P.string "right"
        ]
    -- lookAhead $ char ','
    return $ Direction $ make value
    where make "up"    = North
          make "right" = East
          make "down"  = South
          make "left"  = West
          make _       = Stay

layout :: Parser Value
layout = try $ do
    open <- ignoreWS $ oneOf openingBrackets
    let closing = getMatchingClosingBracket open
    value <- many1 strip <* ignoreWS (char closing)
    return $ Layout value

strip :: Parser Strip
strip = try $ do ignoreWS (char '|') *> ignoreWS (physical `sepBy` char ' ')

physical :: Parser Physical
physical = try $ do
    value <- choice [
        char 'x',
        char '.',
        char '*',
        char 's',
        char 'e'
        ]
    return $ make value
    where make '.' = Walkable
          make '*' = Blocked
          make 's' = Entrance
          make 'e' = Exit
          make _   = Void

------------------------------ 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]