<commit_before>module Lex (l, lexTokens) where

import Control.Applicative
  ( (*>)
  , (<$)
  , (<$>)
  , (<*)
  , (<*>)
  )
import System.Exit (exitFailure)
import System.FilePath (takeExtension)
import System.IO (hPutStrLn, stderr)
-- TODO: custom error messages with <?>
import Text.Parsec ( (<|>)
                   , (<?>)
                   , choice
                   , many
                   , many1
                   , runParser
                   , try
                   )
import Text.Parsec.Prim (parseTest)
import Text.Parsec.String (Parser, parseFromFile)
import Text.Parsec.Combinator (eof)
import Text.ParserCombinators.Parsec.Char (anyChar, char, noneOf, oneOf, string)

data Token = Annotation String
           | Blockquote String
           | Code String
           | CommentStart String
           | DocBlockStart String
           | Heading String
           | Link String
           | LinkTarget String
           | Newline String
           | PreFence String
           | Separator String
           | SubHeading String
           | VimScriptLine String -- later, this gets more complicated
           | Whitespace String
           | Word String
  deriving (Eq, Show)

-- | Parses a translation unit (file contents) into an AST.
lexUnit :: Parser [Token]
lexUnit = (many token) <* eof

token = choice [ annotation
               , blockquote
               , preFence -- must come before code
               , code
               , docBlockStart -- must come before commentStart
               , commentStart
               , subHeading -- must come before heading
               , heading
               , link
               , linkTarget
               , newline
               , separator
               -- , vimScriptLine
               , whitespace
               , word
               ]
               <?> "valid token"

annotationName = choice [ string "command"
                        , string "dedent"
                        , string "footer"
                        , string "indent"
                        , string "mappings" -- must come before mapping
                        , string "mapping"
                        , string "option"
                        , string "plugin"
                        ]

annotation    = Annotation <$> (char '@' *> annotationName)
commentStart  = CommentStart <$> string "\""
blockquote    = Blockquote <$> string ">"
code          = Code <$> (char '`' *> many1 (noneOf "`") <* char '`')
docBlockStart = try $ DocBlockStart <$> string "\"\""
heading       = Heading <$> string "#"
link          = Link <$> (char '|' *> many1 (noneOf "|") <* char '|')
linkTarget    = LinkTarget <$> (char '*' *> many1 (noneOf "*") <* char '*')
newline       = Newline <$> string "\n"
preFence      = try $ PreFence <$> string "```"
separator     = Separator <$> string "---"
subHeading    = try $ Heading <$> string "##"
whitespace    = Whitespace <$> many1 (oneOf " \t")
word          = Word <$> many1 (noneOf " \t\n")

-- Called `lexTokens` instead of `lex` to avoid conflict with `Prelude.lex`.
lexTokens :: String -> IO [Token]
lexTokens fileName = parseFromFile lexUnit fileName >>= either report return
  where
    report err = do
      hPutStrLn stderr $ "Error: " ++ show err
      exitFailure

-- | To facilitate quick testing in the console.
-- import Lex (l)
-- l "test"<commit_msg>Simplify content-free token constructors<commit_after>module Lex (l, lexTokens) where

import Control.Applicative
  ( (*>)
  , (<$)
  , (<$>)
  , (<*)
  , (<*>)
  )
import System.Exit (exitFailure)
import System.FilePath (takeExtension)
import System.IO (hPutStrLn, stderr)
-- TODO: custom error messages with <?>
import Text.Parsec ( (<|>)
                   , (<?>)
                   , choice
                   , lookAhead
                   , many
                   , many1
                   , manyTill
                   , runParser
                   , try
                   )
import Text.Parsec.Prim (parseTest)
import Text.Parsec.String (Parser, parseFromFile)
import Text.Parsec.Combinator (eof)
import Text.ParserCombinators.Parsec.Char (anyChar, char, noneOf, oneOf, string)

data Token = Annotation String
           | Blockquote
           | Code String
           | CommentStart
           | DocBlockStart
           | Heading
           | Link String
           | LinkTarget String
           | ListItem
           | Newline
           | PreFence
           | Separator
           | SubHeading
           | VimScriptLine String -- later, this gets more complicated
           | Whitespace String
           | Word String
  deriving (Eq, Show)

-- | Parses a translation unit (file contents) into an AST.
lexUnit :: Parser [Token]
lexUnit = (many token) <* eof

-- TODO: literal <br /> support
token = choice [ --vimScriptLine -- must come first
               {-,-} annotation
               , blockquote
               , preFence -- must come before code
               , code
               , docBlockStart -- must come before commentStart
               , commentStart
               , subHeading -- must come before heading
               , heading
               , link
               , linkTarget
               , newline
               , separator -- must come before listItem
               , listItem
               , whitespace
               , word
               ]
               <?> "valid token"

annotationName = choice [ string "command"
                        , string "dedent"
                        , string "footer"
                        , string "indent"
                        , string "mappings" -- must come before mapping
                        , string "mapping"
                        , string "option"
                        , string "plugin"
                        ]

annotation    = Annotation <$> (char '@' *> annotationName)
commentStart  = string "\"" >> return CommentStart
blockquote    = string ">" >> return Blockquote
code          = Code <$> (char '`' *> many1 (noneOf "`") <* char '`')
docBlockStart = try $ string "\"\"" >> return DocBlockStart
heading       = string "#" >> return Heading
link          = Link <$> (char '|' *> many1 (noneOf "|") <* char '|')
linkTarget    = LinkTarget <$> (char '*' *> many1 (noneOf "*") <* char '*')
listItem      = string "-" >> return ListItem
newline       = string "\n"  >> return Newline
preFence      = try $ string "```" >> return PreFence
separator     = try $ string "---" >> return Separator
subHeading    = try $ string "##" >> return SubHeading

whitespace    = Whitespace <$> many1 (oneOf " \t")
word          = Word <$> many1 (noneOf " \t\n")

-- Called `lexTokens` instead of `lex` to avoid conflict with `Prelude.lex`.
lexTokens :: String -> IO [Token]
lexTokens fileName = parseFromFile lexUnit fileName >>= either report return
  where
    report err = do
      hPutStrLn stderr $ "Error: " ++ show err
      exitFailure

-- | To facilitate quick testing in the console.
-- import Lex (l)
-- l "test"
{'fraction_non_alphanumeric': 0.11321295500143308, 'fraction_numerical': 0.0017196904557179708, 'mean_word_length': 1.605076521089959, 'pattern_counts': {'":': 0, '<': 48, '<?xml version=': 0, '>': 72, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1291432', 'n_tokens_mistral': 1916, 'n_tokens_neox': 1859, 'n_words': 540}