module Parser (pgnLexer,pgnParser) where

 import GenUtils
 import DataTypes
 import Data.Char -- 1.3



 pgnLexer :: String -> [Token]
 pgnLexer ('.':r) = PeriodToken  : pgnLexer r
 pgnLexer ('*':r) = AsterixToken : pgnLexer r
 pgnLexer ('[':r) = LeftSBToken  : pgnLexer r
 pgnLexer (']':r) = RightSBToken : pgnLexer r
 pgnLexer ('(':r) = LeftRBToken  : pgnLexer r
 pgnLexer (')':r) = RightRBToken : pgnLexer r
 pgnLexer ('<':r) = LeftABToken  : pgnLexer r
 pgnLexer ('>':r) = RightABToken : pgnLexer r
 pgnLexer ('"':r) = readString r ""
 pgnLexer ('{':r) = readComment r ""
 pgnLexer ('$':r) = readNAG r ""
 pgnLexer ('!':'?':r) = mkNAGToken 5 : pgnLexer r
 pgnLexer ('!':'!':r) = mkNAGToken 3 : pgnLexer r
 pgnLexer ('!':r)     = mkNAGToken 1 : pgnLexer r
 pgnLexer ('?':'?':r) = mkNAGToken 4 : pgnLexer r
 pgnLexer ('?':'!':r) = mkNAGToken 6 : pgnLexer r
 pgnLexer ('?':r)     = mkNAGToken 2 : pgnLexer r
 pgnLexer ('%':r) = pgnLexer (dropWhile (/= '\n') r)
 pgnLexer (c:r)
       | isSpace c = pgnLexer r
       | isAlpha c || isDigit c = pgnSymbolLexer r [c]
       | otherwise = error ("Error lexing: " ++ takeWhile (/= '\n') (c:r))
 pgnLexer [] = []

 pgnSymbolLexer (c:r) sym 
       | isAlpha c 
       || isDigit c 
       || elem c "_+#=:-/" = pgnSymbolLexer r (c:sym)
 pgnSymbolLexer r sym 
       | all isDigit sym = IntToken (read (reverse sym)) : pgnLexer r
 pgnSymbolLexer r sym   = SymbolToken (reverse sym) : pgnLexer r

 readString ('\\':'\\':r) str = readString r ('\\':str)
 readString ('\\':'"':r) str = readString r ('"':str)
 readString ('"':r) str     = StringToken (reverse str) : pgnLexer r
 readString (c:r) str       = readString r (c:str)

 readComment ('}':r) str = CommentToken (revwords str []) : pgnLexer r
 readComment (c:r) str = readComment r (c:str)

 revwords (c:r) wds
    | isSpace c = revwords r wds
    | otherwise = revwords' r [c] wds
 revwords [] wds = wds
 revwords' (c:r) wd wds 
    | isSpace c = revwords r (wd:wds)
    | otherwise = revwords' r (c:wd) wds
 revwords' [] wd wds = wd : wds

 readNAG (c:r) str
       | isDigit c = readNAG r (c:str)
 readNAG r str = mkNAGToken (read (reverse str)) : pgnLexer r

 mkNAGToken 1 = NAGAnnToken 1 "!" 
 mkNAGToken 2 = NAGAnnToken 2 "?" 
 mkNAGToken 3 = NAGAnnToken 3 "!!"
 mkNAGToken 4 = NAGAnnToken 4 "??"
 mkNAGToken 5 = NAGAnnToken 5 "!?"
 mkNAGToken 6 = NAGAnnToken 6 "?!"
 mkNAGToken n = NAGToken n




 pgnParser :: (Int -> Bool) -> String -> [AbsGame]
 pgnParser fn str = 
       [ game | (no,game) <- zip [1..] (parseTags (pgnLexer str) id),
                fn no]

 type FL a = [a] -> [a]

 parseTags :: [Token] -> FL TagStr -> [AbsGame]
 parseTags (LeftSBToken:SymbolToken sym:StringToken str:RightSBToken:rest) 
           other_tags = parseTags rest (other_tags . ((:) (TagStr sym str)))
 parseTags toks@(LeftSBToken:_) _
       = error ("BAD Token:" ++ unwords (map userFormat (take 10 toks)))
 parseTags toks tags = parseToks toks id tags

 parseToks :: [Token] 
       -> FL Token 
       -> FL TagStr
       -> [AbsGame]
 parseToks next@(LeftSBToken:_)     = \ toks tags ->
       Game (tags []) (toks []) : parseTags next id
 parseToks (tk:r)                    = pushToken tk r 
 parseToks [] = \ toks tags -> [Game (tags []) (toks [])]

 pushToken tok r toks = parseToks r (toks . ((:) tok))