<commit_before>{-# LANGUAGE FlexibleInstances,
            TypeSynonymInstances,
            MultiParamTypeClasses,
            Rank2Types, FlexibleContexts, NoMonomorphismRestriction,
            CPP #-}

module Lexer2 where

import TokenTypes

import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.Utils
import Text.ParserCombinators.UU.BasicInstances
import Text.ParserCombinators.UU.Derived

parseWhitespace :: Parser String
parseWhitespace = pSome (pSym ' ' <<|> pSym '\n' <<|> pSym '\t' <<|> pSym '\r')

parseAnyChar :: Parser Char
parseAnyChar = pSatisfy (const True) (Insertion "Any character" 'y' 5)

parseCBlockComment :: Parser String
parseCBlockComment = const "" <$> pToken "*/" <<|>
            (:) <$> parseAnyChar <*> parseCBlockComment

-- Parse a multiline string
parseMLString :: Parser String
parseMLString = (++) <$> pToken "[" <*> nestedString

pUntilEnd :: Parser String
pUntilEnd = pMunch (\c -> c /= '\n' && c /= '\r')

parseLineComment :: String -> Parser String
parseLineComment prefix = flip const <$> pToken prefix <*> pUntilEnd

-- Parses a multiline string except for its first character (e.g. =[ string ]=])
-- This is because the first [ could also just be parsed as a square bracket.
nestedString :: Parser String
nestedString = nested 0
    where
        -- The amount of =-signs in the string delimiter is n
        nested :: Int -> Parser String
        nested n = (\str -> "=" ++ str) <$ pToken "=" <*> nested (n + 1) <<|>
                   ('[' :) <$ pToken "[" <*> restString n

        -- Right-recursive grammar. This part searches for the rest of the string until it finds the ]=^n] token
        restString :: Int -> Parser String
        restString n = pToken ("]" ++ replicate n '=' ++ "]") <<|>
                       (:) <$> parseAnyChar <*> restString n

parseComment :: Parser Token
parseComment =  pToken "--" <**> -- Dash block comment and dash comment both start with "--"
                    (const <$> (DashBlockComment <$> parseMLString <<|> DashComment <$> pUntilEnd)) <<|>
                pToken "/" <**>
                    (const <$>
                        (SlashBlockComment <$ pToken "*" <*> parseCBlockComment <<|>
                        SlashComment <$> parseLineComment "/" <<|>
                        pReturn Divide -- The /-sign is here because it also starts with '/'
                        ))

-- Parse single line strings e.g. "sdf", 'werf'
parseLineString :: Char -> Parser String<commit_msg>Fixed the following example being seen as a block comment (Thanks to ULX for finding this bug) --[1]Message, [2]Delay, [3]GroupName/number, [4]Red, [5]Green, [6]Blue, [7]Length, [8]Hold<commit_after>{-# LANGUAGE FlexibleInstances,
            TypeSynonymInstances,
            MultiParamTypeClasses,
            Rank2Types, FlexibleContexts, NoMonomorphismRestriction,
            CPP #-}

module Lexer2 where

import TokenTypes

import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.Utils
import Text.ParserCombinators.UU.BasicInstances
import Text.ParserCombinators.UU.Derived

parseWhitespace :: Parser String
parseWhitespace = pSome (pSym ' ' <<|> pSym '\n' <<|> pSym '\t' <<|> pSym '\r')

parseAnyChar :: Parser Char
parseAnyChar = pSatisfy (const True) (Insertion "Any character" 'y' 5)

parseCBlockComment :: Parser String
parseCBlockComment = const "" <$> pToken "*/" <<|>
            (:) <$> parseAnyChar <*> parseCBlockComment

-- Try to parse a block comment
-- Might actually return a single line Dash comment, because for example
-- the following line is a line comment, rather than a block comment
--[===== <- missing the last '[' bracket
parseBlockComment :: Parser Token
parseBlockComment = pToken "[" *> nested 0
    where
        -- The amount of =-signs in the string delimiter is n
        nested :: Int -> Parser Token
        nested n = pToken "=" *> nested (n + 1) <<|>
                   blockComment n <$ pToken "[" <*> restString n <<|>
                   lineComment n <$> pUntilEnd

        -- Turn the string into a block comment
        blockComment :: Int -> String -> Token
        blockComment n str = DashBlockComment $ '[' : replicate n '=' ++ '[' : str

        -- Turns out we were describing a line comment all along, cheeky bastard!
        -- (the last [ of the block comment start token is missing)
        lineComment :: Int -> String -> Token
        lineComment n str = DashComment $ '[' : replicate n '=' ++ str

        -- Right-recursive grammar. This part searches for the rest of the string until it finds the ]=^n] token
        restString :: Int -> Parser String
        restString n = pToken ("]" ++ replicate n '=' ++ "]") <<|>
                       (:) <$> parseAnyChar <*> restString n

pUntilEnd :: Parser String
pUntilEnd = pMunch (\c -> c /= '\n' && c /= '\r')

parseLineComment :: String -> Parser String
parseLineComment prefix = flip const <$> pToken prefix <*> pUntilEnd

-- Parses a multiline string except for its first character (e.g. =[ string ]=])
-- This is because the first [ could also just be parsed as a square bracket.
nestedString :: Parser String
nestedString = nested 0
    where
        -- The amount of =-signs in the string delimiter is n
        nested :: Int -> Parser String
        nested n = (\str -> "=" ++ str) <$ pToken "=" <*> nested (n + 1) <<|>
                   ('[' :) <$ pToken "[" <*> restString n

        -- Right-recursive grammar. This part searches for the rest of the string until it finds the ]=^n] token
        restString :: Int -> Parser String
        restString n = pToken ("]" ++ replicate n '=' ++ "]") <<|>
                       (:) <$> parseAnyChar <*> restString n

parseComment :: Parser Token
parseComment =  pToken "--" <**> -- Dash block comment and dash comment both start with "--"
                    (const <$> (parseBlockComment <<|> DashComment <$> pUntilEnd)) <<|>
                pToken "/" <**>
                    (const <$>
                        (SlashBlockComment <$ pToken "*" <*> parseCBlockComment <<|>
                        SlashComment <$> parseLineComment "/" <<|>
                        pReturn Divide -- The /-sign is here because it also starts with '/'
                        ))

-- Parse single line strings e.g. "sdf", 'werf'
parseLineString :: Char -> Parser String
{'fraction_non_alphanumeric': 0.13350245758680832, 'fraction_numerical': 0.003171079752655779, 'mean_word_length': 2.4697469746974696, 'pattern_counts': {'":': 0, '<': 96, '<?xml version=': 0, '>': 85, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1100161', 'n_tokens_mistral': 1886, 'n_tokens_neox': 1763, 'n_words': 599}