Wordlint-0.1.0.2: Wordlint.hs
import Data.List
import System.Console.CmdArgs
import Text.PrettyPrint.Boxes
import Wordlint.Args
import Wordlint.Words
import Wordlint.Wordpairs
main :: IO ()
main = do
-- Execute command line arguments, retrieve flags
cargs <- cmdArgs cliargs
let sortflag = sort_ cargs
let wordlen = wordlength cargs
let fname = file cargs
-- If human-readable flag is present, print header
checkIfHumanHeader cargs
-- Acquire String data from file or stdin
dat <- accessInputFileData . checkFileStdin $ file cargs
-- blacklist data for running filter function
blist' <- accessBlacklistFileData . checkFileStdin $ blacklist cargs
let blist = setBlacklistData blist'
--
-- Choose checker and printer according to -t, -h flags
--
case type_ cargs of
[] -> do
let checkedwords' = runWordCheck dat wordlen dist blist cargs
let checkedwords = checkSortFlag sortflag checkedwords'
if human cargs
then do putStrLn "No type chosen; running word-based check"
mapM_ putStrLn (processHumanWordData checkedwords)
putStrLn ""
summaryData (length checkedwords) (wordlength cargs) (length dat)
else
if sortflag == "error"
then putStrLn $ processDataError checkedwords fname
else processMachineWordData checkedwords
where dist = checkDistanceOrAll cargs
"word" -> do
let checkedwords' = runWordCheck dat wordlen dist blist cargs
let checkedwords = checkSortFlag sortflag checkedwords'
if human cargs
then do mapM_ putStrLn (processHumanWordData checkedwords)
putStrLn ""
summaryData (length checkedwords) (wordlength cargs) (length dat)
else
if sortflag == "error"
then putStrLn $ processDataError checkedwords fname
else processMachineWordData checkedwords
where dist = checkDistanceOrAll cargs
"line" -> do
let checkedwords' = runLineCheck dat wordlen dist blist cargs
let checkedwords = checkSortFlag sortflag checkedwords'
if human cargs
then do mapM_ putStrLn (processHumanLineData checkedwords)
putStrLn ""
summaryData (length checkedwords) (wordlength cargs) (length dat)
else
if sortflag == "error"
then putStrLn $ processDataError checkedwords fname
else processMachineLineData checkedwords
where dist = checkDistanceOrAll cargs
"percentage" -> do
let checkedwords' = runPercentageCheck dat wordlen dist blist cargs
let checkedwords = checkSortFlag sortflag checkedwords'
if human cargs
then do mapM_ putStrLn (processHumanPercentageData checkedwords)
putStrLn ""
summaryData (length checkedwords) (wordlength cargs) (length dat)
else
if sortflag == "error"
then putStrLn $ processDataError checkedwords fname
else processMachinePercentageData checkedwords
where dist = checkDistanceOrAll cargs
_ -> do
let checkedwords' = runWordCheck dat wordlen dist blist cargs
let checkedwords = checkSortFlag sortflag checkedwords'
if human cargs
then do putStrLn "No type chosen; running word-based check"
mapM_ putStrLn (processHumanWordData checkedwords)
putStrLn ""
summaryData (length checkedwords) (wordlength cargs) (length dat)
else
if sortflag == "error"
then putStrLn $ processDataError checkedwords fname
else processMachineWordData checkedwords
where dist = checkDistanceOrAll cargs
-- run*Check functions are run with a maybe to account for --all flag
-- process*Data functions return a human-readable format.
-- In the future, a "machine-readable" flag will be added to the latter
-- in order to output for use in text editor plugins.
runWordCheck :: String -> Int -> Maybe Int -> Maybe [String] -> Arguments -> Wordpairs Int
runWordCheck inputdata wordlen distorall blist arg = case distorall of
Nothing -> instring
Just i -> filterWordpairsByDistance instring i
where instring = sortWordsByString . filterMatchingWords $ dwords
dwords = checkWordList fwords wordlen
fwords = runFilterFlags cwords arg blist
cwords = zipWords inputdata "word"
processHumanWordData :: Wordpairs Int -> [String]
processHumanWordData [] = ["No (more) matches found"]
processHumanWordData (x:xs) = ("\'" ++ word ++ "\'"
++ " at positions "
++ position'
++ " at coordinates "
++ coordinates
++ " with an intervening distance of "
++ distance'
++ " words") : processHumanWordData xs
where word = getWordPairString x
position' = show (getWordpairPositions x)
coordinates = show (getWordpairCoords x)
distance' = show (pdiff x)
-- machine-based outputs drawn from
-- http://www.tedreed.info/programming/2012/06/02/how-to-use-textprettyprintboxes/
processMachineWordData :: Wordpairs Int -> IO ()
processMachineWordData x = printBox $ hsep 2 left (map (vcat left . map text)
(transpose $ ["Coord1", "Coord2", "Word", "Distance"]:processMachineWordData' x))
processMachineWordData' :: Wordpairs Int -> [[String]]
processMachineWordData' [] = []
processMachineWordData' (x:xs) = words (coordinates1 coordinates'
++ " "
++ coordinates2 coordinates'
++ " "
++ word
++ " "
++ distance') : processMachineWordData' xs
where word = getWordPairString x
coordinates' = getWordpairCoords x
coordinates1 ((r1,s1),(_,_)) = show r1 ++ "," ++ show s1
coordinates2 ((_,_),(r2,s2)) = show r2 ++ "," ++ show s2
distance' = show (pdiff x)
runLineCheck :: String -> Int -> Maybe Int -> Maybe [String] -> Arguments-> Wordpairs Int
runLineCheck inputdata wordlen distorall blist arg = case distorall of
Nothing -> instring
Just i -> filterWordpairsByDistance instring i
where instring = sortWordsByString . filterMatchingWords $ dwords
dwords = checkWordList fwords wordlen
fwords = runFilterFlags cwords arg blist
cwords = zipWords inputdata "line"
processHumanLineData :: Wordpairs Int -> [String]
processHumanLineData [] = ["No (more) matches found"]
processHumanLineData (x:xs) = ("\'" ++ word ++ "\'"
++ " at coordinates "
++ coordinates
++ " with an intervening distance of "
++ distance'
++ " lines") : processHumanLineData xs
where word = getWordPairString x
coordinates = show (getWordpairCoords x)
distance' = show (pdiff x)
processMachineLineData :: Wordpairs Int -> IO ()
processMachineLineData x = printBox $ hsep 2 left (map (vcat left . map text)
(transpose $ ["Coord1", "Coord2", "Word", "Distance"]:processMachineLineData' x))
processMachineLineData' :: Wordpairs Int -> [[String]]
processMachineLineData' [] = []
processMachineLineData' (x:xs) = words (coordinates1 coordinates'
++ " "
++ coordinates2 coordinates'
++ " "
++ word
++ " "
++ distance')
: processMachineLineData' xs
where word = getWordPairString x
coordinates' = getWordpairCoords x
coordinates1 ((r1,s1),(_,_)) = show r1 ++ "," ++ show s1
coordinates2 ((_,_),(r2,s2)) = show r2 ++ "," ++ show s2
distance' = show (pdiff x)
runPercentageCheck :: String -> Int -> Maybe Double -> Maybe [String] -> Arguments -> Wordpairs Double
runPercentageCheck inputdata wordlen distorall blist arg = case distorall of
Nothing -> instring
Just i -> filterWordpairsByDistance instring i
where instring = sortWordsByString . filterMatchingWords $ dwords
dwords = checkWordList fwords wordlen
fwords = runFilterFlags cwords arg blist
cwords = zipWords inputdata "percentage"
processHumanPercentageData :: Wordpairs Double -> [String]
processHumanPercentageData [] = ["No (more) matches found"]
processHumanPercentageData (x:xs) = ("\'" ++ word ++ "\'"
++ " at coordinates "
++ coordinates
++ " with an intervening distance of %"
++ distance') : processHumanPercentageData xs
where word = getWordPairString x
coordinates = show (getWordpairCoords x)
distance' = take 7 (show (pdiff x))
processMachinePercentageData :: Wordpairs Double -> IO ()
processMachinePercentageData x = printBox $ hsep 2 left (map (vcat left . map text)
(transpose $ ["Coord1", "Coord2", "Word", "Distance"]:processMachinePercentageData' x))
processMachinePercentageData' :: Wordpairs Double -> [[String]]
processMachinePercentageData' [] = []
processMachinePercentageData' (x:xs) = words (coordinates1 coordinates'
++ " "
++ coordinates2 coordinates'
++ " "
++ word
++ " "
++ distance') : processMachinePercentageData' 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)
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."