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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
module Text.CSV
( showCSV, readCSV, readCSVWithDelims
, writeCSVFile, readCSVFile, readCSVFileWithDelims
) where
import List(intersperse)
writeCSVFile :: String -> [[String]] -> IO ()
writeCSVFile fname rows = writeFile fname (showCSV rows)
showCSV :: [[String]] -> String
showCSV rows = concatMap showCSVLine rows
showCSVLine :: [String] -> String
showCSVLine row = concat (intersperse "," (map convert row)) ++ "\n"
where
convert s =
if any (\c->c `elem` ['"',',',';',':','\n']) s
then '"' : concatMap (\c->if c=='"' then [c,c] else [c]) s ++ "\""
else s
readCSVFile :: String -> IO [[String]]
readCSVFile = readCSVFileWithDelims [',']
readCSVFileWithDelims :: [Char] -> String -> IO [[String]]
readCSVFileWithDelims delims fname = do
contents <- readFile fname
return (readCSVWithDelims delims contents)
readCSV :: String -> [[String]]
readCSV = readCSVWithDelims [',']
readCSVWithDelims :: [Char] -> String -> [[String]]
readCSVWithDelims delims str = map (components delims) (lines str)
components :: [Char] -> String -> [String]
components _ [] = [[]]
components delims (c:cs) =
if c=='"' then breakString cs
else let (e,s) = break (`elem` delims) (c:cs)
in e : (if null s then [] else components delims (tail s))
where
breakString [] = delimError
breakString [x] = if x=='"' then [[]]
else delimError
breakString (x:y:zs) | x=='"' && y=='"' = let (b:bs) = breakString zs
in (x:b):bs
| x=='"' && y `elem` delims = []:components delims zs
| otherwise = let (b:bs) = breakString (y:zs)
in (x:b):bs
delimError = error "Missing closing delimiter in CSV record!"
|