<commit_before>module Main where
import System
import Char
import List
import IO


-- search for definitions of things 
-- we do this by looking for the following patterns:
-- data XXX = ...      giving a datatype location
-- newtype XXX = ...   giving a newtype location
-- bla :: ...          giving a function location
--
-- by doing it this way, we avoid picking up local definitions
-- 		(whether this is good or not is a matter for debate)
--

-- We generate both CTAGS and ETAGS format tags files
-- The former is for use in most sensible editors, while EMACS uses ETAGS


main :: IO ()
main = do
	filenames <- getArgs
	filedata <- mapM findthings filenames
	ctagsfile <- openFile "tags" WriteMode
	etagsfile <- openFile "TAGS" WriteMode
	writectagsfile ctagsfile filedata
	writeetagsfile etagsfile filedata
	hClose ctagsfile
	hClose etagsfile
	
type FileName = String

type ThingName = String

-- The position of a token or definition
data Pos = Pos 
		FileName 	-- file name
		Int			-- line number 
		Int     	-- token number
		String 		-- string that makes up that line
	deriving Show

-- A definition we have found
data FoundThing = FoundThing ThingName Pos
	deriving Show

-- Data we have obtained from a file
data FileData = FileData FileName [FoundThing]

data Token = Token String Pos
	deriving Show


-- stuff for dealing with ctags output format

writectagsfile :: Handle -> [FileData] -> IO ()
writectagsfile ctagsfile filedata = do
	let things = concat $ map getfoundthings filedata
	mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) things

getfoundthings :: FileData -> [FoundThing]
getfoundthings (FileData filename things) = things

dumpthing :: FoundThing -> String
dumpthing (FoundThing name (Pos filename line _ _)) = 
	name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)


-- stuff for dealing with etags output format

writeetagsfile :: Handle -> [FileData] -> IO ()
writeetagsfile etagsfile filedata = do
	mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata

e_dumpfiledata :: FileData -> String
e_dumpfiledata (FileData filename things) = 
	"\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
	where 
		thingsdump = concat $ map e_dumpthing things 
		thingslength = length thingsdump

e_dumpthing :: FoundThing -> String
e_dumpthing (FoundThing name (Pos filename line token fullline)) =
	(concat $ take (token + 1) $ spacedwords fullline) 
	++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
	
	
-- like "words", but keeping the whitespace, and so letting us build
-- accurate prefixes	
	
spacedwords :: String -> [String]
spacedwords [] = []
spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
	where 
		(blanks,rest) = span Char.isSpace xs
		(wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
	
	
-- Find the definitions in a file	
	
findthings :: FileName -> IO FileData
findthings filename = do
	text <- readFile filename
	let aslines = lines text
	let wordlines = map words aslines
	let noslcoms = map stripslcomments wordlines
	let tokens = concat $ zipWith3 (withline filename) noslcoms 
					aslines [0 ..]
	let nocoms = stripblockcomments tokens
	return $ FileData filename $ findstuff nocoms
	
-- Create tokens from words, by recording their line number
-- and which token they are through that line

withline :: FileName -> [String] -> String -> Int -> [Token]		
withline filename words fullline i = 
	zipWith (\w t -> Token w (Pos filename i t fullline)) words $ [0 ..]

-- comments stripping

stripslcomments :: [String] -> [String]
stripslcomments ("--":xs) = []
stripslcomments (x:xs) = x : stripslcomments xs 
stripslcomments [] = []

stripblockcomments :: [Token] -> [Token]
stripblockcomments ((Token "\\end{code}" _):xs) = afterlitend xs
stripblockcomments ((Token "{-" _):xs) = afterblockcomend xs
stripblockcomments (x:xs) = x:stripblockcomments xs
stripblockcomments [] = []

afterlitend2 :: [Token] -> [Token]
afterlitend2 (x:xs) = afterlitend xs
afterlitend2 [] = []

afterlitend :: [Token] -> [Token]
afterlitend ((Token "\\begin{code}" _):xs) = xs
afterlitend (x:xs) = afterlitend xs
afterlitend [] = []

afterblockcomend :: [Token] -> [Token]
afterblockcomend ((Token token _):xs) | contains "-}" token = xs
						| otherwise = afterblockcomend xs
afterblockcomend [] = []


-- does one string contain another string

contains :: Eq a => [a] -> [a] -> Bool
contains sub full = any (isPrefixOf sub) $ tails full 
<commit_msg>[project @ 2001-09-20 16:01:53 by rje] Now has better handling of comments.<commit_after>module Main where
import System
import Char
import List
import IO


-- search for definitions of things 
-- we do this by looking for the following patterns:
-- data XXX = ...      giving a datatype location
-- newtype XXX = ...   giving a newtype location
-- bla :: ...          giving a function location
--
-- by doing it this way, we avoid picking up local definitions
-- 		(whether this is good or not is a matter for debate)
--

-- We generate both CTAGS and ETAGS format tags files
-- The former is for use in most sensible editors, while EMACS uses ETAGS


main :: IO ()
main = do
	filenames <- getArgs
	filedata <- mapM findthings filenames
	ctagsfile <- openFile "tags" WriteMode
	etagsfile <- openFile "TAGS" WriteMode
	writectagsfile ctagsfile filedata
	writeetagsfile etagsfile filedata
	hClose ctagsfile
	hClose etagsfile
	
type FileName = String

type ThingName = String

-- The position of a token or definition
data Pos = Pos 
		FileName 	-- file name
		Int			-- line number 
		Int     	-- token number
		String 		-- string that makes up that line
	deriving Show

-- A definition we have found
data FoundThing = FoundThing ThingName Pos
	deriving Show

-- Data we have obtained from a file
data FileData = FileData FileName [FoundThing]
	deriving Show

data Token = Token String Pos
	deriving Show


-- stuff for dealing with ctags output format

writectagsfile :: Handle -> [FileData] -> IO ()
writectagsfile ctagsfile filedata = do
	let things = concat $ map getfoundthings filedata
	mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) things

getfoundthings :: FileData -> [FoundThing]
getfoundthings (FileData filename things) = things

dumpthing :: FoundThing -> String
dumpthing (FoundThing name (Pos filename line _ _)) = 
	name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)


-- stuff for dealing with etags output format

writeetagsfile :: Handle -> [FileData] -> IO ()
writeetagsfile etagsfile filedata = do
	mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata

e_dumpfiledata :: FileData -> String
e_dumpfiledata (FileData filename things) = 
	"\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
	where 
		thingsdump = concat $ map e_dumpthing things 
		thingslength = length thingsdump

e_dumpthing :: FoundThing -> String
e_dumpthing (FoundThing name (Pos filename line token fullline)) =
	(concat $ take (token + 1) $ spacedwords fullline) 
	++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
	
	
-- like "words", but keeping the whitespace, and so letting us build
-- accurate prefixes	
	
spacedwords :: String -> [String]
spacedwords [] = []
spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
	where 
		(blanks,rest) = span Char.isSpace xs
		(wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
	
	
-- Find the definitions in a file	
	
findthings :: FileName -> IO FileData
findthings filename = do
	text <- readFile filename
	let aslines = lines text
	let wordlines = map words aslines
	let noslcoms = map stripslcomments wordlines
	let tokens = concat $ zipWith3 (withline filename) noslcoms 
					aslines [0 ..]
	let nocoms = stripblockcomments tokens
	return $ FileData filename $ findstuff nocoms
	
-- Create tokens from words, by recording their line number
-- and which token they are through that line

withline :: FileName -> [String] -> String -> Int -> [Token]		
withline filename words fullline i = 
	zipWith (\w t -> Token w (Pos filename i t fullline)) words $ [0 ..]

-- comments stripping

stripslcomments :: [String] -> [String]
stripslcomments (x:xs) | isPrefixOf "--" x = []
					   | otherwise = x : stripslcomments xs
stripslcomments [] = []

stripblockcomments :: [Token] -> [Token]
stripblockcomments ((Token "\\end{code}" _):xs) = 
	stripblockcomments $ afterlitend xs
stripblockcomments ((Token "{-" _):xs) = 
	stripblockcomments $ afterblockcomend xs
stripblockcomments (x:xs) = x:stripblockcomments xs
stripblockcomments [] = []

afterlitend2 :: [Token] -> [Token]
afterlitend2 (x:xs) = afterlitend xs
afterlitend2 [] = []

afterlitend :: [Token] -> [Token]
afterlitend ((Token "\\begin{code}" _):xs) = xs
afterlitend (x:xs) = afterlitend xs
afterlitend [] = []

afterblockcomend :: [Token] -> [Token]
afterblockcomend ((Token token _):xs) | contains "-}" token = xs
						| otherwise = afterblockcomend xs
afterblockcomend [] = []


-- does one string contain another string

contains :: Eq a => [a] -> [a] -> Bool
contains sub full = any (isPrefixOf sub) $ tails full 

{'fraction_non_alphanumeric': 0.10961794757885385, 'fraction_numerical': 0.00444247001332741, 'mean_word_length': 3.639361154044307, 'pattern_counts': {'":': 1, '<': 13, '<?xml version=': 0, '>': 55, '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': '5084062', 'n_tokens_mistral': 2939, 'n_tokens_neox': 2741, 'n_words': 1029}