Gui*_*ess 3 csv evaluation haskell strict
我正在尝试接收CSV文件,错误检查它然后打印错误消息.
mapM_(appendFile filePath)(返回[string]的errorCheck函数)
这可以工作,但是当我运行它但在非常长的CSV上它会耗尽内存.我认为问题在于它过于懒惰,并且在它执行任何操作之前将整个CSV加载到内存中.我已尝试使用BangPatterns强制执行严格性但我不确定我是否正确使用它因为它没有帮助
我可以提供更多信息或代码,但我不确定与我的问题有什么关系
码:
main = do
safeRead s = catch (readFile s) $ \_ -> return ""
filePath <- safeRead "in.txt"
file <- safeRead filePath
--save the errors
writeFile (createErrorFilePath filePath) (getFileName $ filePath ++ "\n")
let !addToErr = do appendFile (createErrorFilePath filePath)
mapM_ addToErr (map ('\n':) (errorCheckFile (( \(Right x) -> x ) (parseCSV file)) (errorCheckCols (checkCols . head $ (( \(Right x) -> x ) (parseCSV file))) errorMsgs)))
--exit with correct number
exitWith . ExitFailure . exitCtrl $ (errorCheckFile (( \(Right x) -> x ) (parseCSV file)) (errorCheckCols (checkCols $ head $ (( \(Right x) -> x ) (parseCSV file))) errorMsgs))
--decides what value to exit with, depends on if errors, warnings or nothing
exitCtrl :: [String] -> Int
exitCtrl [] = 1
exitCtrl (line:rest)
| ("ERROR:") == take 6 line = 3
-- | elem ("WARNING:") line = 1
| otherwise = exitCtrl rest
--gets a files name given a filepath
getFileName :: String -> String
getFileName filePath = reverse $ takeWhile (/= '\\') (reverse filePath)
--changes the input filepath to create a new error file at the same location
createErrorFilePath :: String -> String
createErrorFilePath pathIn = (reverse $ drop 4 (reverse pathIn)) ++ "_error_log.txt"
--check if any of the columns errored
errorCheckCols :: [Int] -> [String] -> String
errorCheckCols cols errors
| errorPos == Nothing = "All headings are accounted for :)"
| otherwise = errors !! (fromJust errorPos)
where errorPos = findIndex (== 1-2) cols
--This takes the file and if any of the columns don't exists, tells you, otherwise it error checks the database
errorCheckFile :: [[String]] -> String -> [String]
errorCheckFile [] _ = ["ERROR: No Data"]
errorCheckFile (headings:[]) colErrorMsg = ["ERROR: No Data"]
errorCheckFile (headings:info) colErrorMsg
| length headings > 25 = ["ERROR: Too many Columns of data"]
| colErrorMsg == "All headings are accounted for :)" =
checkDB
info
(findCol "example name 1" headings 3)
(findCol "example name 2" headings 5)
(findCol "example name 3" headings 5)
(findCol "example name 4" headings 3)
(findCol "example name 5" headings 3)
(findCol "example name 6" headings 3)
(findCol "example name 7" headings 8)
(findCol "example name 8" headings 3)
(findCol "example name 9" headings 15)
(findCol "example name 10" headings 15)
(findCol "example name 11" headings 3)
(findCol "example name 12" headings 3)
(findCol "example name 13" headings 9)
(findCol "example name 14" headings 16)
(findCol "example name 15" headings 9)
(findCol "example name 16" headings 16)
(findCol "example name 17" headings 3)
(findCol "example name 18" headings 3)
(findCol "example name 19" headings 8)
(findCol "example name 20" headings 3)
((findCol "example name 21" headings 20) + (findCol "example name 21 alt" headings 20) + 1)
(findCol "example name 22" headings 22)
(findCol "example name 23" headings 3)
(findCol "example name 24" headings 3)
(findCol "example name 25" headings 9)
1
| otherwise = [colErrorMsg]
--given the inputs headings, finds the positions if each row by name
checkCols :: [String] -> [Int]
checkCols headings = [(findCol "example name 1" headings 3),
(findCol "example name 2" headings 5),
(findCol "example name 3" headings 5),
(findCol "example name 4" headings 3),
(findCol "example name 5" headings 3),
(findCol "example name 6" headings 3),
(findCol "example name 7" headings 8),
(findCol "example name 8" headings 3),
(findCol "example name 9" headings 15),
(findCol "example name 10" headings 15),
(findCol "example name 11" headings 3),
(findCol "example name 12" headings 3),
(findCol "example name 13" headings 9),
(findCol "example name 14" headings 16),
(findCol "example name 15" headings 9),
(findCol "example name 16" headings 16),
(findCol "example name 17" headings 3),
(findCol "example name 18" headings 3),
(findCol "example name 19" headings 8),
(findCol "example name 20" headings 3),
((findCol "example name 21" headings 20) + (findCol "example name 21 alt" headings 20) + 1),
(findCol "example name 22" headings 22),
(findCol "example name 23" headings 3),
(findCol "example name 24" headings 3),
(findCol "example name 25" headings 9)]
-- [[String]] Intx25 Int(count) returns a [String]
checkDB :: [[String]] -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> [String]
checkDB [] _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = ["ERROR: Filename given does not exist"]
checkDB (lastRow:[]) pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 count
| map (toUpper) (lastRow !! pos4) == "ASD" = checkASD lastRow pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 count
| map (toUpper) (lastRow !! pos4) == "QWE" || map (toUpper) (lastRow !! pos4) == "DPS" = checkQWE lastRow pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos18 pos19 pos24 pos25 pos17 count
| otherwise = ["ERROR: identifier not valid on line " ++ (show count)]
checkDB (firstRow:otherRows) pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 count
-- | count `mod` 50 == 0 = []
| map (toUpper) (firstRow !! pos4) == "ASD" = checkASD firstRow pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 count ++ checkDB otherRows pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 (count+1)
| map (toUpper) (firstRow !! pos4) == "QWE" || map (toUpper) (firstRow !! pos4) == "DPS" = checkQWE firstRow pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos18 pos19 pos24 pos25 pos17 count ++ checkDB otherRows pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 (count+1)
| otherwise = ["ERROR: identifier not valid on line " ++ (show count)] ++ checkDB otherRows pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 (count+1)
--collection of error checking methods for ASD rows
checkASD :: [String] -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> [String]
checkASD row pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 count
| sum ans == 0 = []
| (findIndex (>=20) ans /= Nothing && findIndex (>0) ans /= Nothing) = ["WARNING: At line " ++ (show count) ++ " at column(s) " ++ (show (cols!!(fromJust(findIndex (>=20) ans)) + 1))]
| findIndex (>=20) ans /= Nothing = ["WARNING: At line " ++ (show count) ++ " at column(s) " ++ (show (cols!!(fromJust(findIndex (>=20) ans)) + 1)) ++ "\nERROR: At line " ++ (show count) ++ " at column(s) " ++ unwords( map show( map (+1) (map (cols!!) (findIndices (>0) (init ans)))))]
| otherwise = ["ERROR: At line " ++ (show count) ++ " at column(s) " ++ unwords( map show( map (cols!!) (findIndices (>0) ans))) ]
where
ans = [errorCheck (row!!pos1) ["01","02","03","04","05"],
errorCheck (row!!pos2) ["3","4"],
errorCheck (row!!pos3) ["1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20"],
checkTypeLength (row!!pos5) isDigit 5,
sum [ checkLength (row!!pos6) 12, errorCheckNL (row!!pos6) ],
checkDate (row!!pos7),
checkTypeLength (row!!pos8) checkSex 1,
checkDate (row!!pos9),
checkDate (row!!pos10),
checkLength (row!!pos11) 5,
checkTypeLength (row!!pos12) isDigit 5,
checkMoney (row!!pos13),
checkMoney (row!!pos14),
checkMoney (row!!pos15),
checkMoney (row!!pos16),
checkLength (row!!pos17) 10,
checkLength (row!!pos18) 2,
checkDate (row!!pos19),
checkTypeLength (row!!pos20) isDigit 5,
checkTypeLength (row!!pos21) isDigit 5,
checkLength (row!!pos22) 1,
checkLength (row!!pos23) 1]
cols = [pos1, pos2, pos3, pos5, pos6, pos7, pos8, pos9, pos10, pos11, pos12, pos13, pos14, pos15, pos16, pos17, pos18, pos19, pos20, pos21, pos22, pos23]
--cols is a quick fix for finding where errors have occured
--collection of error checking methods for QWE/DPS rows
checkQWE :: [String] -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> [String]
checkQWE row pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos18 pos19 pos24 pos25 pos17 count
| sum ans == 0 = []
| (findIndex (>=20) ans /= Nothing && findIndex (>0) ans /= Nothing) = ["WARNING: At line " ++ (show count) ++ " at column(s) " ++ (show (cols!!(fromJust(findIndex (>=20) ans)) + 1))]
| findIndex (>=20) ans /= Nothing = ["WARNING: At line " ++ (show count) ++ " at column(s) " ++ (show (cols!!(fromJust(findIndex (>=20) ans)) + 1)) ++ "\nERROR: At line " ++ (show count) ++ " at column(s) " ++ unwords( map show( map (+1) (map (cols!!) (findIndices (>0) (init ans)))))]
| otherwise = ["ERROR: At line " ++ (show count) ++ " at column(s) " ++ unwords( map show (map (cols!!) (findIndices (>0) ans))) ]
where
ans = [errorCheck (row!!pos1) ["01","02","03","04","05","06","07","08","1","2","3","4","5","6","7","8"],
errorCheck (row!!pos2) ["1","2","3","4"],
errorCheck (row!!pos3) ["1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","31","32"],
checkTypeLength (row!!pos5) isDigit 5,
sum [ checkLength (row!!pos6) 12, errorCheckNL (row!!pos6) ],
checkDate (row!!pos7),
checkTypeLength (row!!pos8) checkSex 1,
checkDate (row!!pos9),
checkDate (row!!pos10),
checkLength (row!!pos11) 5,
checkTypeLength (row!!pos12) isDigit 5,
checkMoney (row!!pos13),
checkMoney (row!!pos14),
checkMoney (row!!pos15),
checkMoney (row!!pos16),
checkLength (row!!pos18) 2,
checkDate (row!!pos19),
checkDate (row!!pos24),
checkMoney (row!!pos25),
checkQWEpos17 (row!!pos17)]
cols = [pos1, pos2, pos3, pos5, pos6, pos7, pos8, pos9, pos10, pos11, pos12, pos13, pos14, pos15, pos16, pos18, pos19, pos24, pos25, pos17]
--cols is a quick fix for finding where errors have occured
--checks that a string is 'm' or 'f'
checkSex :: Char -> Bool
checkSex input
| toLower input == 'm' || toLower input == 'f' = True
| otherwise = False
--finds if a row has something other than 1 type and are of a certain length
checkTypeLength :: String -> (Char -> Bool) -> Int -> Int
checkTypeLength [] _ _ = 1
checkTypeLength el isType maxSize
| length el > 0 && length el <= maxSize && (and $ map isType el) = 0
| otherwise = 1
--finds elements that exceed a certain length
checkLength :: String -> Int -> Int
checkLength [] _ = 1
checkLength el maxSize
| length el <= maxSize && length el > 0 = 0
| otherwise = 1
--finds a columns position given its name and the list of column names, else returns -1
findCol :: String -> [String] -> Int -> Int
findCol colName header unique --unique is the number of letters of each word that need to be compared
| findMatch /= Nothing = fromJust findMatch
| otherwise = -1
where findMatch = findIndex (==(map (toLower) (take unique colName))) (map (map toLower) (map (take unique) header))
--finds if a line where the element is not a letter and number ONLY, returns col num or 0
errorCheckNL :: String -> Int
errorCheckNL [] = 1
errorCheckNL (el1:el2:el3:rest)
| isDigit el1 && isDigit el2 && isDigit el3 && and(map isLetter rest) = 0 --return Nothing?
| otherwise = 2
errorCheckNL others = 3
-- given a row, the column num to check, options of what the column and a counter==0, returns row num or 0
errorCheck :: String -> [String] -> Int
errorCheck [] _ = 1
errorCheck el options
| map toLower el `elem` options = 0
| otherwise = 1
--finds if a date is valid given a row, the column num to check and a counter=0, returns row num or 0
checkDate :: String -> Int
checkDate [] = 1
checkDate el
| sepPos1 == Nothing = 1 --error: this is not formated as a date, there's no separator
| sepPos2 == Nothing = 2 --error: this is not formated as a date, there's no separator
| day `notElem` ["1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","31"] = 3
| (map toLower month) `notElem` ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"] = 4 --error: month is not valid
| length (tail year) == 4 && and (map isDigit (tail year)) = 22
| length (tail year) == 2 && and (map isDigit (tail year)) = 0
| otherwise = 5
where
sepPos1 = findIndex (== '-') el --maybe
(day, rest) = splitAt (fromJust sepPos1) el
sepPos2 = findIndex (== '-') (tail rest) --maybe
(month, year) = splitAt (fromJust sepPos2) (tail rest)
--checks that quantities of money are presented correctly
checkMoney :: String -> Int
checkMoney [] = 4
checkMoney cash
| decimalPoint == Nothing && checkTypeLength cash isDigit 9 /= 0 = 1 --error: not numbers
| decimalPoint /= Nothing && checkTypeLength (tail cents) isDigit 2 /= 0 = 2 --error: not numbers after the decimal point
| decimalPoint /= Nothing && checkTypeLength euros isDigit 9 /= 0 = 3 --error: not numbers after the decimal point
| otherwise = 0
where
decimalPoint = findIndex (== '.') cash --maybe
(euros, cents) = splitAt (fromJust decimalPoint) cash
Run Code Online (Sandbox Code Playgroud)
这段代码
(( \(Right x) -> x ) (parseCSV file))
Run Code Online (Sandbox Code Playgroud)
表示几乎不可能以parseCSV
递增方式解析文件并开始返回部分结果而不消耗整个文件.如果这是不可能的
parseCSV
的结果将是Left something
在格式错误输入的情况下,以及Right result
在形成阱输入的情况下和在消耗完整输入之前,无法知道解析是否成功,因此无法确定结果是否为Left errorMessage
或Right result
.
此外,您使用两次解析结果,一次用于将消息附加到日志文件,一次用于确定退出代码.第二种用法包含对它的引用,因此它(或者,在多次评估的情况下,文件内容)不能被垃圾收集.
另外,你可以在四个地方使用那段代码.根据编译器如何执行常见的子表达式消除,文件最多可解析四次.将解析结果绑定到名称以避免多次评估更安全.
如果您知道文件格式正确,则可以通过以块为单位解析文件来减少空间使用,例如,按行进行并仅执行遍历一次(记录并确定退出代码的组合).适合该遍历的模式是Control.Monad.foldM
,
logAndUpdate file exitCode record = do
appendFile file (message record)
return $! update exitCode (exitInfo record)
Run Code Online (Sandbox Code Playgroud)
主要:
exitCode <- foldM (logAndUpdate filename) 0 (parsedRecords)
exitWith $ ExitCode exitCode
Run Code Online (Sandbox Code Playgroud)
如果线是独立的,则类似的策略是可能的,因此畸形线的存在不会影响前后良好形状线的处理,然后每条线将被解析为Either ParseError Record
.如果格式错误的行只影响后续行,而不影响之前的行,则仍然可以通过在遇到格式错误的行时停止解析或切换解析器.
但是如果格式错误的行使整个文件无效,则可能无法在或多或少的空间中执行此操作.如果期望的结构允许,它可以在两个通道中完成,一个用于检查良好形成,一个用于解析.
归档时间: |
|
查看次数: |
219 次 |
最近记录: |