<commit_before>{-# LANGUAGE OverloadedStrings #-}
module Radiation.Parsers.Internal.CStyle where

import Data.Attoparsec.ByteString.Char8 as BP
import Data.Attoparsec.ByteString.Lazy as Lazy
import qualified Data.Attoparsec.ByteString as BB

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Char8 as BSC

import qualified Data.Char as C

import Control.Applicative
import Control.Monad

import My.Utils

import Debug.Trace

attribute :: Parser BS.ByteString
attribute = do
    string "__attribute__" 
    skipSpace
    balancedParens

removePattern :: Parser BS.ByteString -> Parser BS.ByteString
removePattern pattern  = BS.concat <$> many ((pattern >> return BS.empty) <|>
                                             (BS.singleton <$> BB.anyWord8))

subparse :: Parser BS.ByteString -> Parser a -> Parser a
subparse bsParser myParser = do
    bs' <- bsParser
    case parseOnly myParser bs' of
        Left err -> fail err
        Right map -> return map
    
(+>) :: Parser BS.ByteString -> Parser BS.ByteString -> Parser BS.ByteString
(+>) p1 p2 = BS.append <$> p1 <*> p2

{- Take an identifier from the parser -}
identifier :: Parser BS.ByteString
identifier = skipSpace *> BP.takeWhile isIdentifierChar <* skipSpace

notIdentifier :: Parser BS.ByteString
notIdentifier = skipSpace *> BP.takeWhile (\c -> not (isIdentifierChar c || isSpace c)) <* skipSpace

isIdentifierChar :: Char -> Bool
isIdentifierChar ch = C.isDigit ch || C.isAlpha ch || ch == '_'

between :: Char -> Char -> Parser BS.ByteString
between open close = skipSpace *> char open *> (between open close <|> BP.takeWhile sat) <* char close
    where sat ch = ch /= open && ch /= close

balanced :: Char -> Char -> Parser BS.ByteString
balanced c1 c2 = 
    let
        looseBalanced :: BS.ByteString -> Int -> Parser BS.ByteString
        looseBalanced cur 0 = return cur
        looseBalanced cur n = do
            ch <- BP.anyChar
            let cur' = cur `BS.append` BSC.singleton ch
            case ch of 
                c1 -> looseBalanced cur' (n + 1)
                c2 -> looseBalanced cur' (n - 1)
                _ ->   looseBalanced cur' n
        in

    BP.char c1 >> looseBalanced (BSC.singleton c1) 1

balancedParens :: Parser BS.ByteString
balancedParens = balanced '(' ')'

body :: Parser BS.ByteString
body = balanced '{' '}'

parens :: Parser BS.ByteString
parens = between '(' ')' 

nextWord :: BS.ByteString -> Parser BS.ByteString
nextWord str = BP.takeWhile C.isSpace +> string str

primitive :: Parser BS.ByteString
primitive  = skipSpace *> choice [integral, floating] -- >>= (\bs -> if BS.null bs then fail "" else return bs)
    where integral = option "" (option "" (string "un") +> nextWord "signed") +> choice (map nextWord ["int","char"])
          floating = string "float"


data CTypeHeader = CTypeHeader (Maybe (BS.ByteString,BS.ByteString)) 

{- Parses a type in C. Tries to do all possibilities, including
 - anonymous structures, but alas it proves difficult -}
ctype :: Parser CTypeHeader
ctype = (<|>) (primitive $> CTypeHeader Nothing) $ do

    typeoftype <- optional (choice $ fmap string ["struct","enum","union"])
    id1 <- (body $> Nothing) <|> (Just <$> (identifier <* body))

    identifier `mplus` (BSC.pack <$> many (skipSpace *> char '*' <* skipSpace))

    return $ CTypeHeader ((,) <$> typeoftype <*> id1)

{- Parses C++ types. These inculde the apersaned for
 - references -}
cpptype :: Parser BS.ByteString
cpptype = identifier `mplus` (BSC.pack <$> many (skipSpace *> (char '*' <|> char '&') <* skipSpace))
<commit_msg>Guards, not case<commit_after>{-# LANGUAGE OverloadedStrings #-}
module Radiation.Parsers.Internal.CStyle where

import Data.Attoparsec.ByteString.Char8 as BP
import Data.Attoparsec.ByteString.Lazy as Lazy
import qualified Data.Attoparsec.ByteString as BB

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Char8 as BSC

import qualified Data.Char as C

import Control.Applicative
import Control.Monad

import My.Utils

import Debug.Trace

attribute :: Parser BS.ByteString
attribute = do
    string "__attribute__" 
    skipSpace
    balancedParens

removePattern :: Parser BS.ByteString -> Parser BS.ByteString
removePattern pattern  = BS.concat <$> many ((pattern >> return BS.empty) <|>
                                             (BS.singleton <$> BB.anyWord8))

subparse :: Parser BS.ByteString -> Parser a -> Parser a
subparse bsParser myParser = do
    bs' <- bsParser
    case parseOnly myParser bs' of
        Left err -> fail err
        Right map -> return map
    
(+>) :: Parser BS.ByteString -> Parser BS.ByteString -> Parser BS.ByteString
(+>) p1 p2 = BS.append <$> p1 <*> p2

{- Take an identifier from the parser -}
identifier :: Parser BS.ByteString
identifier = skipSpace *> BP.takeWhile isIdentifierChar <* skipSpace

notIdentifier :: Parser BS.ByteString
notIdentifier = skipSpace *> BP.takeWhile (\c -> not (isIdentifierChar c || isSpace c)) <* skipSpace

isIdentifierChar :: Char -> Bool
isIdentifierChar ch = C.isDigit ch || C.isAlpha ch || ch == '_'

between :: Char -> Char -> Parser BS.ByteString
between open close = skipSpace *> char open *> (between open close <|> BP.takeWhile sat) <* char close
    where sat ch = ch /= open && ch /= close

balanced :: Char -> Char -> Parser BS.ByteString
balanced c1 c2 = 
    let
        looseBalanced :: BS.ByteString -> Int -> Parser BS.ByteString
        looseBalanced cur 0 = return cur
        looseBalanced cur n = do
            ch <- BP.anyChar
            let cur' = cur `BS.append` BSC.singleton ch
            case () of 
                () | ch == c1  -> looseBalanced cur' (n + 1)
                   | ch == c2  -> looseBalanced cur' (n - 1)
                   | otherwise -> looseBalanced cur' n
        in

    BP.char c1 >> looseBalanced (BSC.singleton c1) 1

balancedParens :: Parser BS.ByteString
balancedParens = balanced '(' ')'

body :: Parser BS.ByteString
body = balanced '{' '}'

parens :: Parser BS.ByteString
parens = between '(' ')' 

nextWord :: BS.ByteString -> Parser BS.ByteString
nextWord str = BP.takeWhile C.isSpace +> string str

primitive :: Parser BS.ByteString
primitive  = skipSpace *> choice [integral, floating] -- >>= (\bs -> if BS.null bs then fail "" else return bs)
    where integral = option "" (option "" (string "un") +> nextWord "signed") +> choice (map nextWord ["int","char"])
          floating = string "float"


data CTypeHeader = CTypeHeader (Maybe (BS.ByteString,BS.ByteString)) 

{- Parses a type in C. Tries to do all possibilities, including
 - anonymous structures, but alas it proves difficult -}
ctype :: Parser CTypeHeader
ctype = (<|>) (primitive $> CTypeHeader Nothing) $ do

    typeoftype <- optional (choice $ fmap string ["struct","enum","union"])
    id1 <- (body $> Nothing) <|> (Just <$> (identifier <* body))

    identifier `mplus` (BSC.pack <$> many (skipSpace *> char '*' <* skipSpace))

    return $ CTypeHeader ((,) <$> typeoftype <*> id1)

{- Parses C++ types. These inculde the apersaned for
 - references -}
cpptype :: Parser BS.ByteString
cpptype = identifier `mplus` (BSC.pack <$> many (skipSpace *> (char '*' <|> char '&') <* skipSpace))

{'fraction_non_alphanumeric': 0.12414171930788245, 'fraction_numerical': 0.005218346608074705, 'mean_word_length': 3.0938729623383923, 'pattern_counts': {'":': 0, '<': 51, '<?xml version=': 0, '>': 111, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '810510', 'n_tokens_mistral': 2316, 'n_tokens_neox': 2214, 'n_words': 714}