diff --git a/Wordlint.cabal b/Wordlint.cabal --- a/Wordlint.cabal +++ b/Wordlint.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: Wordlint -version: 0.2.0.3 +version: 0.2.0.4 synopsis: Plaintext prose redundancy linter. description: Wordlint locates matching pairs of words repeated within a user-defined @@ -41,10 +41,16 @@ extra-source-files: changelog extra-doc-files: doc/Wordlint.haddock man/man1/wordlint.1 +library + hs-source-dirs: src + exposed-modules: Wordlint.Args, Wordlint.Linters, Wordlint.Output, Wordlint.Wordpairs, Wordlint.Words + build-depends: base >=4.7 && <4.8, cmdargs >=0.10.0 && <0.11.0, boxes >=0.1 && <0.2 + default-language: Haskell2010 executable wordlint - hs-source-dirs: src, src/Wordlint + hs-source-dirs: src main-is: Wordlint.hs + other-modules: Wordlint.Args, Wordlint.Linters, Wordlint.Output, Wordlint.Wordpairs, Wordlint.Words other-extensions: DeriveDataTypeable build-depends: base >=4.7 && <4.8, cmdargs >=0.10.0 && <0.11.0, boxes >=0.1 && <0.2 default-language: Haskell2010 diff --git a/man/man1/wordlint.1 b/man/man1/wordlint.1 --- a/man/man1/wordlint.1 +++ b/man/man1/wordlint.1 @@ -1,4 +1,4 @@ -.TH "WORDLINT" "1" "2015\-02\-24" "0.2.0.3 +.TH "WORDLINT" "1" "2015\-02\-24" "0.2.0.4 .SH Name .PP wordlint \- plaintext redundancy linter diff --git a/src/Wordlint/Args.hs b/src/Wordlint/Args.hs new file mode 100644 --- /dev/null +++ b/src/Wordlint/Args.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module Wordlint.Args where + +import System.Console.CmdArgs +import Control.Monad +import Wordlint.Words +import Wordlint.Wordpairs + +-- CLI Arguments +-- Data structure and init function for CmdArgs +data Arguments = Arguments + {file :: String + -- linting options + ,matchlength :: Int + ,words_ :: Int + ,lines_ :: Int + ,percent_ :: Double + -- filters + ,nocaps :: Bool + ,nopunct :: Bool -- ,ignore-punctuation :: Bool goddammit + ,blacklist :: String + -- output options + ,all_ :: Bool + ,human :: Bool + ,sort_ :: String + } + deriving (Data, Typeable, Show, Read) + +cliargs :: Arguments +cliargs = Arguments + {file = "" &= help "If not present, read from stdin" &= typFile + -- linting options + ,matchlength = 5 &= help "Minimum length of matched words" &= typ "Int" + ,words_ = 0 &= help "Maximum distance between matches - number of words. Default 250." &= typ "Int" + ,lines_ = 0 &= help "Maximum distance between matches - number of lines" &= typ "Int" + ,percent_ = 0 &= help "Maximum distance between matches - percentage of words." &= typ "Double" + + -- filters + ,nocaps = False &= help "Ignore capitalization when finding matches." + ,nopunct = False &= help "Ignore punctuation when finding matches." + ,blacklist = "" &= help "File with newline-separated list of words to filter from output." + &= typFile + + -- output options + ,all_ = False &= help "Show all matched results regardless of intervening distance" + ,human = False &= help "Print resutlts in human-readable form." + ,sort_ = "position" &= help "Sort alphabetically, by position, or by intervening distance" + &= typ "word|position|distance|error" + } + &= help "wordlint [OPTION]...[-f FILE]..." + &= summary "Wordlint v0.2.0.4 Gardner 2014 WTFPL" + &= details ["Wordlint finds pairs of repeated words within a given" + ,"numerical range of words, lines or percentage of the input." + ,"This should be useful to curb redundancy in prose."] +-------------------------------------------------------------------------------- +-- +-- Input file/stdin functions +-- +-------------------------------------------------------------------------------- +checkFileStdin :: String -> Maybe String +checkFileStdin s | null s = Nothing + | otherwise = Just s + + +accessInputFileData :: Maybe String -> IO String +accessInputFileData f = + case f of + Nothing -> getContents + Just fp -> readFile fp + +accessBlacklistFileData :: Maybe String -> IO String +accessBlacklistFileData f = + case f of + Nothing -> return "" + Just fp -> readFile fp + +setBlacklistData :: String -> Maybe [String] +setBlacklistData a | null a = Nothing + | otherwise = Just $ lines a + + +-------------------------------------------------------------------------------- +-- +-- Filter functions +-- +-------------------------------------------------------------------------------- + +runFilterFlags :: (NumOps a) => Words a -> Arguments -> Maybe [String] -> Words a +runFilterFlags w arg blist = runCapsFilter arg $ runBlacklistFilter blist $ + runPunctFilter arg $ runBlacklistFilter blist w + +runPunctFilter :: (NumOps a) => Arguments -> Words a -> Words a +runPunctFilter arg wordlist = if nopunct arg + then filterWordPunctuation wordlist + else wordlist + +runCapsFilter :: (NumOps a) => Arguments -> Words a -> Words a +runCapsFilter arg wordlist = if nocaps arg + then filterWordCapitalization wordlist + else wordlist + +runBlacklistFilter :: (NumOps a) => Maybe [String] -> Words a -> Words a +runBlacklistFilter blist wordlist = case blist of + Nothing -> wordlist + Just x -> filterWordBlacklist wordlist x + +-------------------------------------------------------------------------------- +-- +-- Output flag functions +-- +-------------------------------------------------------------------------------- + +-- Handle --sort flag +checkSortFlag :: (Num a, Ord a, NumOps a) => String -> Wordpairs a -> Wordpairs a +checkSortFlag x y | x == "position" = sortWordPairsByPosition y + | x == "distance" = sortWordPairsByDistance y + | x == "word" = y + | x == "error" = sortWordPairsByPosition y + | otherwise = y + + +-- Header to print if --human flag is present +checkIfHumanHeader :: Arguments -> IO () +checkIfHumanHeader cargs = when (human cargs) + $ putStrLn ("Running " + ++ getTypeOfCheck cargs + ++ " check[s] on " + ++ file cargs + ++ "\nWith minimum distance[s] of " + ++ getTypeOfCheck cargs + ++ " between words of length " + ++ show (matchlength cargs) ++ "\n") + +getTypeOfCheck :: Arguments -> String +getTypeOfCheck c = isWordsFlag c ++ " " ++ isLinesFlag c ++ " " ++ isPercentFlag c + + +getTypeNumbers :: Arguments -> String +getTypeNumbers c = convertWordsFlag c ++ " " ++ + convertLinesFlag c ++ " " ++ convertPercentFlag c + + +isWordsFlag :: Arguments -> String +isWordsFlag c | words_ c /= 0 || + words_ c == 0 && lines_ c == 0 && percent_ c == 0 = "word" + | otherwise = "" + +isLinesFlag :: Arguments -> String +isLinesFlag c | lines_ c /= 0 = "line" + | otherwise = "" + +isPercentFlag :: Arguments -> String +isPercentFlag c | percent_ c /= 0 = "percentage" + | otherwise = "" + +convertWordsFlag :: Arguments -> String +convertWordsFlag c | words_ c /= 0 = show $ words_ c + | otherwise = "" + +convertLinesFlag :: Arguments -> String +convertLinesFlag c | lines_ c /= 0 = show $ lines_ c + | otherwise = "" + +convertPercentFlag :: Arguments -> String +convertPercentFlag c | percent_ c /= 0 = show $ percent_ c + | otherwise = "" diff --git a/src/Wordlint/Linters.hs b/src/Wordlint/Linters.hs new file mode 100644 --- /dev/null +++ b/src/Wordlint/Linters.hs @@ -0,0 +1,94 @@ +module Wordlint.Linters where + +import Control.Monad +import Data.List +import Data.Function +import Wordlint.Args +import Wordlint.Words +import Wordlint.Wordpairs + +-- Linter data type which holds external input and parameters +-- necessary to easily +data Linter = Linter { + inputdata :: String + ,wordlength :: Int + ,allornot :: Bool + ,maybeblacklist :: Maybe [String] + ,word' :: Int + ,line' :: Int + ,percent' :: Double + ,args :: Arguments + ,result :: Wordpairs Double +} + +-- Get and run linters +getLinter :: Arguments -> IO Linter +getLinter cargs = do + -- get filename + dat <- accessInputFileData . checkFileStdin $ file cargs + blist <- liftM setBlacklistData $ accessBlacklistFileData. checkFileStdin $ blacklist cargs + let mlen = matchlength cargs + let isall = all_ cargs + let w' = words_ cargs + let l = lines_ cargs + let p = percent_ cargs + let w = if l == 0 && p == 0.0 && w' == 0 + then 250 + else w' + return $ Linter dat mlen isall blist w l p cargs [] + +runAllLinters :: Linter -> Wordpairs Double +runAllLinters linter = intersectWordpairs y + where words'' = distorall linter (getWordpairListWords linter) (word' linter) + cwords = commensurateWordpairs words'' + lines'' = distorall linter (getWordpairListLines linter) (line' linter) + clines = commensurateWordpairs lines'' + perc = distorall linter (getWordpairListPercent linter) (percent' linter) + y = sortBy (flip compare `on` length) [cwords,clines,perc] + +intersectWordpairs :: [Wordpairs Double] -> Wordpairs Double +intersectWordpairs [] = [] +intersectWordpairs [a,[],[]] = a +intersectWordpairs [a,b,[]] = a `intersect` b +intersectWordpairs [a,b,c] = a `intersect` intersect b c +intersectWordpairs _ = [] + + +getWordpairList :: (Num a, NumOps a) => Linter -> String -> Wordpairs a +getWordpairList linter type' = instring + where instring = sortWordsByString . filterMatchingWords $ dwords + dwords = checkWordList fwords wordlen + fwords = runFilterFlags cwords arg blist + cwords = zipWords in' type' + wordlen = wordlength linter + in' = inputdata linter + arg = args linter + blist = maybeblacklist linter + +distorall :: (Eq a, Ord a, Num a, NumOps a) => Linter -> Wordpairs a -> a -> Wordpairs a +distorall linter wordpairs num = + if allornot linter + then wordpairs + else filterWordpairsByDistance wordpairs num + +getWordpairListWords :: Linter -> Wordpairs Int +getWordpairListWords l = if word' l /= 0 then getWordpairList l "word" else [] + +getWordpairListLines :: Linter -> Wordpairs Int +getWordpairListLines l = if line' l /= 0 then getWordpairList l "line" else [] + +getWordpairListPercent :: Linter -> Wordpairs Double +getWordpairListPercent l = if percent' l /= 0 then getWordpairList l "percent" else [] + +commensurateWordpairs :: Wordpairs Int -> Wordpairs Double +commensurateWordpairs = map commensurateWordpair + +commensurateWordpair :: Wordpair Int -> Wordpair Double +commensurateWordpair x = Wordpair a b c + where a = commensurateWords $ wone x + b = commensurateWords $ wtwo x + c = fromIntegral $ pdiff x + +commensurateWords :: Word Int -> Word Double +commensurateWords x = Word (lemma x) pos (line x) (column x) + where pos = fromIntegral $ position x diff --git a/src/Wordlint/Output.hs b/src/Wordlint/Output.hs new file mode 100644 --- /dev/null +++ b/src/Wordlint/Output.hs @@ -0,0 +1,80 @@ +module Wordlint.Output where + +import Data.List +import Text.PrettyPrint.Boxes +import Wordlint.Args +import Wordlint.Linters +import Wordlint.Words +import Wordlint.Wordpairs + +produceOutput :: (Show a, Eq a, Ord a, Num a, NumOps a) => Linter -> Wordpairs a -> IO () +produceOutput linter wordpairs + | ishuman = + do mapM_ putStrLn (processHumanData wordpairs') + putStrLn "" + summary + | iserrorfmt = putStrLn $ processDataError wordpairs' filename + | otherwise = processMachineData wordpairs' + where cargs = args linter + filename = if file cargs /= "" then file cargs else "stdin" + ishuman = human cargs + sortflag = sort_ cargs + iserrorfmt = sortflag == "error" + wordpairs' = checkSortFlag sortflag wordpairs + summary + = summaryData (length wordpairs) (matchlength cargs) + (length $ inputdata linter) + +processHumanData :: (Show a) => Wordpairs a -> [String] +processHumanData [] = ["No (more) matches found"] +processHumanData (x:xs) = ("\'" ++ word ++ "\'" + ++ " at coordinates " + ++ coordinates + ++ " with an intervening distance of " + ++ distance') : processHumanData xs + where word = getWordPairString x + coordinates = show (getWordpairCoords x) + distance' = take 7 (show (pdiff x)) + +processMachineData :: (Show a) => Wordpairs a -> IO () +processMachineData x = printBox $ hsep 2 left (map (vcat left . map text) + (transpose $ ["Coord1", "Coord2", "Word", "Distance"]:processMachineData' x)) + +processMachineData' :: (Show a) => Wordpairs a -> [[String]] +processMachineData' [] = [] +processMachineData' (x:xs) = words (coordinates1 coordinates' + ++ " " + ++ coordinates2 coordinates' + ++ " " + ++ word + ++ " " + ++ distance') : processMachineData' xs + where word = getWordPairString x + coordinates' = getWordpairCoords x + coordinates1 ((r1,s1),(_,_)) = show r1 ++ "," ++ show s1 + coordinates2 ((_,_),(r2,s2)) = show r2 ++ "," ++ show s2 + distance' = take 7 $ show (pdiff x) +-- Function if "error" is passed as --sort flag argument +processDataError :: (NumOps a) => Wordpairs a -> String -> String +processDataError [] _ = "" +processDataError (x:xs) fname = (fname ++ ":" ++ linum1 ++ ":" ++ colnum1 ++ ":" ++ word ++ "\n") ++ + (fname ++ ":" ++ linum2 ++ ":" ++ colnum2 ++ ":" ++ word ++ "\n") ++ + processDataError xs fname + where word = getWordPairString x + coordinates' = getWordpairCoords x + coordinates1 ((r1,_),(_,_)) = show r1 + coordinates1' ((_,_),(r1,_)) = show r1 + linum1 = coordinates1 coordinates' + linum2 = coordinates1' coordinates' + coordinates2 ((_,s1),(_,_)) = show s1 + coordinates2' ((_,_),(_,s1)) = show s1 + colnum1 = coordinates2 coordinates' + colnum2 = coordinates2' coordinates' + +-- Function that provides summary totals when -h flag is passed +summaryData :: Int -> Int -> Int -> IO() +summaryData x y z = do + putStrLn "" + putStrLn $ "Found " ++ show x ++ " pairs of words " + ++ show y ++ " or more characters in length out of " + ++ show z ++ " words total." diff --git a/src/Wordlint/Wordpairs.hs b/src/Wordlint/Wordpairs.hs new file mode 100644 --- /dev/null +++ b/src/Wordlint/Wordpairs.hs @@ -0,0 +1,114 @@ +module Wordlint.Wordpairs where +import Data.List +import Wordlint.Words + +-- +-- This module contains types and functions for working with pairs of matching +-- words and the distances between them. The key type is a Wordpair, which +-- contains two Word elements and the difference between their Positions. +-- + +data Wordpair a = Wordpair + {wone :: Word a + ,wtwo :: Word a + ,pdiff :: a + } + +type Wordpairs a = [Wordpair a] + +-- Wordpair equality based on coordinates so that +-- union of multiple checks can be found regardless +-- +instance Eq (Wordpair a) where + x == y = getWordpairCoords x == getWordpairCoords y +----------------------------------------------------------------- +-- +-- Creating and filtering Wordpairs +-- +----------------------------------------------------------------- +makeWordpairs :: (Num a, NumOps a) => Word a -> Word a -> Wordpair a +makeWordpairs wx@(Word _ x _ _) wy@(Word _ y _ _) = Wordpair wx wy (y-x) + +-- Convert a list of matching (but separately-located) Words into a list of +-- Wordpair elements. This counts by two +sortWordsByString :: (Num a, NumOps a) => Words a -> Wordpairs a +sortWordsByString [] = [] +sortWordsByString [_] = [] +sortWordsByString [x,xs] = [makeWordpairs x xs | x `checkWordEquality` xs] +sortWordsByString ( x:y:xs ) = if x `checkWordEquality` y + then makeWordpairs x y : sortWordsByString (y:xs) + else sortWordsByString (y:xs) + +filterWordpairsByDistance :: (Num a, Eq a, Ord a, NumOps a) => Wordpairs a -> a -> Wordpairs a +filterWordpairsByDistance [] _ = [] + +filterWordpairsByDistance (x:xs) i = if pdiff x <= i + then x : filterWordpairsByDistance xs i + else filterWordpairsByDistance xs i + +----------------------------------------------------------------- +-- +-- Sorting wordpairs +-- +----------------------------------------------------------------- + +sortWordPairsByPosition :: (Num a, Ord a, NumOps a) => Wordpairs a -> Wordpairs a +sortWordPairsByPosition [] = [] +sortWordPairsByPosition [_] = [] +sortWordPairsByPosition xs = sortBy positionsort xs + where positionsort (Wordpair (Word _ x _ _) _ _ ) (Wordpair (Word _ y _ _) _ _) + | x < y = LT + | x > y = GT + | x == y = EQ + positionsort Wordpair{} Wordpair{} = EQ + +sortWordPairsByDistance :: (Num a, Ord a, NumOps a) => Wordpairs a -> Wordpairs a +sortWordPairsByDistance [] = [] +sortWordPairsByDistance [_] = [] +sortWordPairsByDistance xs = sortBy positionsort xs + where positionsort (Wordpair _ _ x ) (Wordpair _ _ y ) + | x < y = LT + | x > y = GT + | x == y = EQ + positionsort Wordpair{} Wordpair{} = EQ + +----------------------------------------------------------------- +-- +-- Functions to extract data from Wordpairs for easier printing +-- +----------------------------------------------------------------- + +getWordPairString :: Wordpair a -> String +getWordPairString wp = if wordone == wordtwo + then wordone + else + "Error with word pair" + where + wordone = lemma $ wone wp + wordtwo = lemma $ wtwo wp + +getWordpairPositions :: (NumOps a) => Wordpair a -> (a,a) +getWordpairPositions wp = (position $ wone wp,position $ wtwo wp) + +getWordpairLines :: (NumOps a) => Wordpair a -> (Int,Int) +getWordpairLines wp = (line $ wone wp,line $ wtwo wp) + + +-- return ((Line,Col)(Line,Col)) +getWordpairCoords :: Wordpair a -> ((Int,Int),(Int,Int)) +getWordpairCoords wp = ((line firstword,column firstword),(line secondword,column secondword)) + where + firstword = wone wp + secondword = wtwo wp + +showFirstWordpairCoords :: (Show a) => Wordpair a -> String +showFirstWordpairCoords x = lin ++ "," ++ col + where lin = show $ line wor + col = show $ column wor + wor = wone x + +showSecondWordpairCoords :: (Show a) => Wordpair a -> String +showSecondWordpairCoords x = lin ++ "," ++ col + where lin = show $ line wor + col = show $ column wor + wor = wtwo x diff --git a/src/Wordlint/Words.hs b/src/Wordlint/Words.hs new file mode 100644 --- /dev/null +++ b/src/Wordlint/Words.hs @@ -0,0 +1,201 @@ +module Wordlint.Words where +import Data.Char (isPunctuation, toLower) +import Data.List + +-- +-- This module contains types and functions for working with words and their +-- positions used in processing of file. A "Word" is a data structure +-- containing a word string; its position by word count, line, or percentage of +-- file used to calculate intervening distances; and its line and and column +-- positions used when returning data. +-- +-- To create each word, four sets of functions each provide one element and +-- these are zipped together for each word in the file. A Word's "lemma" is +-- first returned by the basic prelude function `words` and therefore includes +-- punctuation marks. While this is required in order to identify the correct +-- coordinates for each Word, this default is also helpful to catch, for +-- example, the repetition of transition words such as "Furthermore,". +-- +-- Punctuation and capitalization filters, as well as a user-defined word +-- blacklist, are available to filter the list of Words prior to matching +-- duplicates. + + +data Word a = Word + { lemma :: String + ,position :: a + ,line :: Int + ,column :: Int } + +type Words a = [Word a] + +--Words are tested for equality and ordered by their lemma +instance Eq (Word a) where + x == y = lemma x == lemma y + +instance Ord (Word a) where + compare x y = compare (lemma x) (lemma y) + +----------------------------------------------------------------- +-- +--Word creation +-- +----------------------------------------------------------------- + +-- +-- Position +-- Create list of tuples containing lemma and word position +-- "Position" depends on type-of-check +-- For word and line checks, Position is an Int representing +-- the word count and line positions, respectively. +-- A percentage check returns a Position of type Double, +-- representing the Word's position as a percentage of +-- total words in the file. +-- + +class NumOps a where + createPos :: String -> String -> [(String, a)] + +instance NumOps Double where + createPos text _ = createPercentPos text + +instance NumOps Int where + createPos = wordOrLine + +wordOrLine :: String -> String -> [(String, Int)] +wordOrLine s t = case t of + "word" -> createWordPos s + "line" -> createLinePos s + _ -> createWordPos s + +createWordPos :: String -> [(String, Int)] +createWordPos s = zip (words s) [1..] + +createLinePos :: String -> [(String, Int)] +createLinePos = createWordLinePos + +createPercentPos :: String -> [(String, Double)] +createPercentPos s = getWordPercentPos wrdlst wrdln + where wrdln = length $ words s + wrdlst = createWordPos s + +getWordPercentPos :: [(String, Int)] -> Int -> [(String, Double)] +getWordPercentPos [] _ = [] +getWordPercentPos (x:xs) y = divWordPercentPos x y : getWordPercentPos xs y + +divWordPercentPos :: (String, Int) -> Int -> (String, Double) +divWordPercentPos (s,x) y = (s,p) + where xi = fromIntegral x + yi = fromIntegral y + p = (xi/yi)*100 +-- +-- Line coordinate +-- Create list of tuples containing lemma and line position + +createWordLinePos :: String -> [(String, Int)] +createWordLinePos xs = setWordLines $ zip (getWordLines xs) [1..] + +-- Makes lists of words by line, fed to the functions below +getWordLines :: String -> [[String]] +getWordLines xs = fmap words (lines xs) + +setWordLine :: ([String], Int) -> [(String, Int)] +setWordLine (([],_)) = [] +setWordLine ((x:xs,i)) = (x,i) : setWordLine (xs,i) + +setWordLines :: [([String], Int)] -> [(String, Int)] +setWordLines [] = [] +setWordLines (x:xs) = setWordLine x ++ setWordLines xs + +-- Column coordinate +-- 1) lines on file and zip infinite lists for each char. [[(Char,Int)]] +-- 2) compare first char of words from each inner [[String]] +-- and add Int from [[(Char,Int)]] when Char == first Char of string + +createWordColPos :: String -> [(String, Int)] +createWordColPos xs = setWordCols lin $ numWordCols lin + where lin = lines xs + +-- number columns in each line of file +numWordCols :: [String] -> [[(Char,Int)]] +numWordCols [[]] = [[]] +numWordCols [] = [[]] +numWordCols (x:xs) = zip x [1..] : numWordCols xs + +-- call filter on lines +setWordCols :: [String] -> [[(Char,Int)]] -> [(String,Int)] +setWordCols [] [] = [] +setWordCols (_:_) [] = [] +setWordCols [] (_:_) = [] +setWordCols (x:xs) (y:ys) = filtWordCols (words x) y ++ setWordCols xs ys + +filtWordCols :: [String] -> [(Char,Int)] -> [(String,Int)] +filtWordCols [] _ = [] +filtWordCols _ [] = [] +filtWordCols w@(x:xs) c@(y:ys) = if (fst y == ' ') || (fst y /= head x) + then filtWordCols w ys + else (x,snd y) : filtWordCols xs (drop (length x) c ) + +-- +-- Master functoion to create a list of words from a file. +zipWords :: (NumOps a) => String -> String -> Words a +zipWords s t = zipWith4 Word (words s) (wordpos s t) linepos colpos + where + linepos = snd . unzip $ createWordLinePos s + colpos = snd . unzip $ createWordColPos s + wordpos u v = snd . unzip $ createPos u v + +----------------------------------------------------------------- +-- +-- Functions that operate on Word(s) type +-- +----------------------------------------------------------------- + +-- Check a word against the minimum word length (matchlength Arguments in Wordlint.Args) +isCheckWordLong :: (NumOps a) => Word a -> Int -> Bool +isCheckWordLong (Word w _ _ _) x = length w > x + +-- Filter Words based on minimum word length +checkWordList :: (NumOps a) => Words a -> Int -> Words a +checkWordList [] _ = [] +checkWordList (x:xs) i = if isCheckWordLong x i + then x : checkWordList xs i + else checkWordList xs i + +-- Equality function checking for string match in different coordinate positions +-- Converts coordinates to tuples to ensure proper equality checking +checkWordEquality :: (NumOps a) => Word a -> Word a -> Bool +checkWordEquality (Word a _ b c) (Word x _ y z) = coord1 /= coord2 && a==x + where coord1 = (b,c) + coord2 = (y,z) + +-- Function to determine distance between two words. Uses Position of Word +-- rather than coordinates so that it is type-of-search independent +-- +checkWordDistance :: (Num a, NumOps a) => Word a -> Word a -> a +checkWordDistance (Word _ x _ _) (Word _ y _ _) = x - y + +-- Filter all but matching pairs of words +filterMatchingWords :: (NumOps a) => Words a -> Words a +filterMatchingWords [] = [] +filterMatchingWords xs = sort $ intersectBy checkWordEquality xs xs + +-- The following filter functions are denoted by the --nopunct, --nocaps and +-- --blacklist flags. These functions are used prior to creating Wordpair +-- types from Words and should not affect the above checkWordEquality function +-- used in building the former. + +-- Filter punctuation with --nopunct flag +filterWordPunctuation :: (NumOps a) => Words a -> Words a +filterWordPunctuation xs = [Word [a | a <- lemma x, not $ isPunctuation a] + (position x) (line x) (column x) | x <- xs] + +-- Filter capitals with --nocaps flag +filterWordCapitalization :: (NumOps a) => Words a -> Words a +filterWordCapitalization xs = [Word [toLower a | a <- lemma x] + (position x) (line x) (column x) | x <- xs] + + +--Filter blacklist given in file denoted by -b flag +filterWordBlacklist :: (NumOps a) => Words a -> [String] -> Words a +filterWordBlacklist xs blacklist = [x | x <- xs, let w = lemma x, w `notElem` blacklist]