<commit_before>{-# LANGUAGE BangPatterns,OverloadedStrings #-}

module TclParse ( TclWord(..)
                 ,doInterp 
                 ,runParse 
                 ,parseList 
                 ,doVarParse
                 ,parseSub
                 ,TokCmd
                 ,parseSubst
                 ,Subst(..)
                 ,tclParseTests
                )  where
 

import BSParse
import Util 
import qualified Data.ByteString.Char8 as B
import Test.HUnit

data TclWord = Word !B.ByteString 
             | Subcommand TokCmd 
             | NoSub !B.ByteString (Result [TokCmd])
             | Expand TclWord deriving (Show,Eq)

type TokCmd = (TclWord, [TclWord])


runParse :: Parser [TokCmd]
runParse = parseStatements `wrapWith` asCmds
 where asCmds lst = [ let (c:a) = x in (c,a) | x <- lst, not (null x)]


parseStatements :: Parser [[TclWord]]
parseStatements = multi1 (eatSpaces .>> parseStatement) `pass` parseEof
  

parseStatement :: Parser [TclWord]
parseStatement = choose [eatAndNext, parseEof, parseTokens]
 where stmtSep = parseOneOf "\n;" .>> eatSpaces 
       eatAndNext = (stmtSep `orElse` parseComment) .>> parseStatement

parseComment = pchar '#' .>> parseMany (ignored `orElse` (eat escapedChar)) .>> eatSpaces
 where ignored = eat (getPred1 (`notElem` "\n\\") "not newline or slash")
       eat p = p .>> emit ()

parseTokens :: Parser [TclWord]
parseTokens = parseMany1 (eatSpaces .>> parseToken)

parseToken :: Parser TclWord
parseToken str = do 
   h <- safeHead "token" str
   case h of
     '{'  -> (parseExpand `orElse` parseNoSub) str
     '['  -> (parseSub `wrapWith` Subcommand) str
     '"'  -> (parseRichStr `wrapWith` Word) str
     '\\' -> handleEsc str
     _    -> (wordToken `wrapWith` Word) str
 where parseNoSub = parseBlock `wrapWith` mkNoSub
       parseExpand = parseLit "{*}" .>> (parseToken `wrapWith` Expand)

mkNoSub s = NoSub s (runParse s)

parseRichStr = pchar '"' .>> (inside `wrapWith` B.concat) `pass` (pchar '"')
 where noquotes = getPred1 (`notElem` "\"\\[$") "non-quote chars"
       inside = parseMany $ choose [noquotes, escapedChar, consumed parseSub, inner_var]
       inner_var = consumed (doVarParse `orElse` pchar '$')

parseSub :: Parser TokCmd
parseSub s = do 
  (p,aft) <- brackets parseTokens $ s
  case p of
    [] -> fail "empty subcommand"
    (ph:pt) -> return ((ph,pt), aft)

handleEsc :: Parser TclWord
handleEsc = line_continue `orElse` esc_word
 where line_continue = parseLit "\\\n" .>> eatSpaces .>> parseToken
       esc_word = (chain [escapedChar, tryGet wordToken]) `wrapWith` Word

-- List parsing
parseList s = parseList_ s >>= return . fst
parseList_ :: Parser [BString]
parseList_ = eatWhite .>> (parseEof `orElse` multi1 plistItem)
 where isWhite = (`elem` " \t\n")
       eatWhite st = return ((), B.dropWhile isWhite st)
       plistItem = listDisp `pass` eatWhite

listDisp str = do h <- safeHead "list item" str
                  case h of
                   '{' -> parseBlock str
                   '"' -> parseStr str 
                   _   -> getListItem str

getListItem s = if B.null w then fail "can't parse list item" else return (w,n)
 where (w,n) = B.splitAt (listItemEnd s) s

listItemEnd s = inner 0 False where 
   inner i esc = if i == B.length s then i
                     else if esc then inner (i+1) False
                           else case B.index s i of
                                  '\\' -> inner (i+1) True
                                  v  -> if v `B.elem` "{}\" \t\n" then i else inner (i+1) False


-- TODO: UGLY
getInterp :: Parser (BString, Either BString TokCmd)
getInterp str = do
   loc <- case B.findIndex (\x -> x == '$' || x == '[') str of
            Just v -> return v
            Nothing -> fail "no matching $ or ["
   if escaped loc str
     then dorestfrom loc str
     else let res = pjoin (,) (parseLen loc) interpItem
          in (res `orElse` dorestfrom loc) str
 where dorestfrom loc = eatAndContinue (parseLen (loc+1)) 
       interpItem = (doVarParse `wrapWith` Left) `orElse` (parseSub `wrapWith` Right) 
       eatAndContinue f = pjoin (\s (p,v) -> (B.append s p, v)) f getInterp

data Subst = SStr !BString | SEsc !Char | 
             SVar !BString | SCmd TokCmd deriving (Eq,Show)

parseSubst :: (Bool,Bool,Bool) -> Parser [Subst]
parseSubst (vars,esc,cmds) = inner `wrapWith` sreduce
 where no_special = getPred1 (`notElem` "\\[$") "non-special chars"
       inner = parseMany (choose [st no_special, 
                                  may vars SVar doVarParse,
                                  may cmds SCmd parseSub,
                                  tryEsc,
                                  st parseAny])
       st x = x `wrapWith` SStr
       may b c f = if b then f `wrapWith` c else st (consumed f)
       tryEsc = if esc then (escChar `wrapWith` SEsc) else (\_ -> fail "no esc") 
       escChar = pchar '\\' .>> (parseAny `wrapWith` B.head)
       sreduce lst = case lst of
               []                 -> []
               (SStr x:SStr y:xs) -> sreduce ((SStr (B.append x y)):xs)
               (x:xs) -> x : sreduce xs

doVarParse :: Parser BString
doVarParse = pchar '$' .>> parseVarRef

parseVarRef :: Parser BString
parseVarRef = chain [ parseVarTerm `orElse` getNS
                      ,tryGet parseVarRef
                      ,tryGet parseInd ]
 where getNS = chain [parseLit "::", parseVarTerm, tryGet getNS]

parseVarTerm :: Parser BString
parseVarTerm = getVar `orElse` braceVar
 where getVar = getPred1 wordChar "word"

parseInd :: Parser BString
parseInd = chain [pchar '(', getPred (/= ')'), pchar ')']

wordToken = consumed (parseMany1 (someVar `orElse` inner `orElse` someCmd))
 where simple = getPred1 (`notElem` " $[]\n\t;\\") "inner word"
       inner = consumed (parseMany1 (simple `orElse` escapedChar)) 
       someVar = chain_ [pchar '$', parseVarBody, tryGet parseInd]
       someCmd = consumed (brackets parseTokens)

parseVarBody = (braceVar `wrapWith` braceIt) `orElse` pthing
 where braceIt w = B.concat ["{", w , "}"]
       pthing = getPred1 (`notElem` "( ${}[]\n\t;") "inner word"

escaped v s = escaped' v
 where escaped' !i
         | i <= 0    = False 
         | otherwise = (B.index s (i-1) == '\\') && not (escaped' (i-1))

doInterp str = case getInterp str of
                   Left _ -> Left (escapeStr str)
                   Right ((pr,s), r) -> Right (escapeStr pr, s, r)
<commit_msg>Made variable name parsing code more sane.<commit_after>{-# LANGUAGE BangPatterns,OverloadedStrings #-}

module TclParse ( TclWord(..)
                 ,doInterp 
                 ,runParse 
                 ,parseList 
                 ,doVarParse
                 ,parseSub
                 ,TokCmd
                 ,parseSubst
                 ,Subst(..)
                 ,tclParseTests
                )  where
 

import BSParse
import Util 
import qualified Data.ByteString.Char8 as B
import Test.HUnit

data TclWord = Word !B.ByteString 
             | Subcommand TokCmd 
             | NoSub !B.ByteString (Result [TokCmd])
             | Expand TclWord deriving (Show,Eq)

type TokCmd = (TclWord, [TclWord])


runParse :: Parser [TokCmd]
runParse = parseStatements `wrapWith` asCmds
 where asCmds lst = [ let (c:a) = x in (c,a) | x <- lst, not (null x)]


parseStatements :: Parser [[TclWord]]
parseStatements = multi1 (eatSpaces .>> parseStatement) `pass` parseEof
  

parseStatement :: Parser [TclWord]
parseStatement = choose [eatAndNext, parseEof, parseTokens]
 where stmtSep = parseOneOf "\n;" .>> eatSpaces 
       eatAndNext = (stmtSep `orElse` parseComment) .>> parseStatement

parseComment = pchar '#' .>> parseMany (ignored `orElse` (eat escapedChar)) .>> eatSpaces
 where ignored = eat (getPred1 (`notElem` "\n\\") "not newline or slash")
       eat p = p .>> emit ()

parseTokens :: Parser [TclWord]
parseTokens = parseMany1 (eatSpaces .>> parseToken)

parseToken :: Parser TclWord
parseToken str = do 
   h <- safeHead "token" str
   case h of
     '{'  -> (parseExpand `orElse` parseNoSub) str
     '['  -> (parseSub `wrapWith` Subcommand) str
     '"'  -> (parseRichStr `wrapWith` Word) str
     '\\' -> handleEsc str
     _    -> (wordToken `wrapWith` Word) str
 where parseNoSub = parseBlock `wrapWith` mkNoSub
       parseExpand = parseLit "{*}" .>> (parseToken `wrapWith` Expand)

mkNoSub s = NoSub s (runParse s)

parseRichStr = pchar '"' .>> (inside `wrapWith` B.concat) `pass` (pchar '"')
 where noquotes = getPred1 (`notElem` "\"\\[$") "non-quote chars"
       inside = parseMany $ choose [noquotes, escapedChar, consumed parseSub, inner_var]
       inner_var = consumed (doVarParse `orElse` pchar '$')

parseSub :: Parser TokCmd
parseSub s = do 
  (p,aft) <- brackets parseTokens $ s
  case p of
    [] -> fail "empty subcommand"
    (ph:pt) -> return ((ph,pt), aft)

handleEsc :: Parser TclWord
handleEsc = line_continue `orElse` esc_word
 where line_continue = parseLit "\\\n" .>> eatSpaces .>> parseToken
       esc_word = (chain [escapedChar, tryGet wordToken]) `wrapWith` Word

-- List parsing
parseList s = parseList_ s >>= return . fst
parseList_ :: Parser [BString]
parseList_ = eatWhite .>> (parseEof `orElse` multi1 plistItem)
 where isWhite = (`elem` " \t\n")
       eatWhite st = return ((), B.dropWhile isWhite st)
       plistItem = listDisp `pass` eatWhite

listDisp str = do h <- safeHead "list item" str
                  case h of
                   '{' -> parseBlock str
                   '"' -> parseStr str 
                   _   -> getListItem str

getListItem s = if B.null w then fail "can't parse list item" else return (w,n)
 where (w,n) = B.splitAt (listItemEnd s) s

listItemEnd s = inner 0 False where 
   inner i esc = if i == B.length s then i
                     else if esc then inner (i+1) False
                           else case B.index s i of
                                  '\\' -> inner (i+1) True
                                  v  -> if v `B.elem` "{}\" \t\n" then i else inner (i+1) False


-- TODO: UGLY
getInterp :: Parser (BString, Either BString TokCmd)
getInterp str = do
   loc <- case B.findIndex (\x -> x == '$' || x == '[') str of
            Just v -> return v
            Nothing -> fail "no matching $ or ["
   if escaped loc str
     then dorestfrom loc str
     else let res = pjoin (,) (parseLen loc) interpItem
          in (res `orElse` dorestfrom loc) str
 where dorestfrom loc = eatAndContinue (parseLen (loc+1)) 
       interpItem = (doVarParse `wrapWith` Left) `orElse` (parseSub `wrapWith` Right) 
       eatAndContinue f = pjoin (\s (p,v) -> (B.append s p, v)) f getInterp

data Subst = SStr !BString | SEsc !Char | 
             SVar !BString | SCmd TokCmd deriving (Eq,Show)

parseSubst :: (Bool,Bool,Bool) -> Parser [Subst]
parseSubst (vars,esc,cmds) = inner `wrapWith` sreduce
 where no_special = getPred1 (`notElem` "\\[$") "non-special chars"
       inner = parseMany (choose [st no_special, 
                                  may vars SVar doVarParse,
                                  may cmds SCmd parseSub,
                                  tryEsc,
                                  st parseAny])
       st x = x `wrapWith` SStr
       may b c f = if b then f `wrapWith` c else st (consumed f)
       tryEsc = if esc then (escChar `wrapWith` SEsc) else (\_ -> fail "no esc") 
       escChar = pchar '\\' .>> (parseAny `wrapWith` B.head)
       sreduce lst = case lst of
               []                 -> []
               (SStr x:SStr y:xs) -> sreduce ((SStr (B.append x y)):xs)
               (x:xs) -> x : sreduce xs

doVarParse :: Parser BString
doVarParse = pchar '$' .>> parseVarRef

parseVarRef :: Parser BString
parseVarRef = chain [ initial 
                      ,tryGet getNS
                      ,tryGet parseInd ]
 where getNS = chain [sep, parseVarTerm, tryGet getNS]
       initial = chain [tryGet sep, parseVarTerm]
       sep = parseLit "::"

parseVarTerm :: Parser BString
parseVarTerm = getVar `orElse` braceVar
 where getVar = getPred1 wordChar "word"

parseInd :: Parser BString
parseInd = chain [pchar '(', getPred (/= ')'), pchar ')']

wordToken = consumed (parseMany1 (someVar `orElse` inner `orElse` someCmd))
 where simple = getPred1 (`notElem` " $[]\n\t;\\") "inner word"
       inner = consumed (parseMany1 (simple `orElse` escapedChar)) 
       someVar = chain_ [pchar '$', parseVarBody, tryGet parseInd]
       someCmd = consumed (brackets parseTokens)

parseVarBody = (braceVar `wrapWith` braceIt) `orElse` pthing
 where braceIt w = B.concat ["{", w , "}"]
       pthing = getPred1 (`notElem` "( ${}[]\n\t;") "inner word"

escaped v s = escaped' v
 where escaped' !i
         | i <= 0    = False 
         | otherwise = (B.index s (i-1) == '\\') && not (escaped' (i-1))

doInterp str = case getInterp str of
                   Left _ -> Left (escapeStr str)
                   Right ((pr,s), r) -> Right (escapeStr pr, s, r)

{'fraction_non_alphanumeric': 0.12469912260268655, 'fraction_numerical': 0.0031058311980743845, 'mean_word_length': 2.23455549974887, 'pattern_counts': {'":': 2, '<': 15, '<?xml version=': 0, '>': 109, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 18, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5026914', 'n_tokens_mistral': 4267, 'n_tokens_neox': 4071, 'n_words': 1295}