blob: 49408430c4da9ef47c9d95e42f96adf69b98c1ce (
plain)
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
|
{- |
Module : Coalpit.DSV
Description : DSV printing and parsing
Maintainer : defanor <defanor@uberspace.net>
Stability : unstable
Portability : non-portable (uses GHC extensions)
This module provides functions for DSV printing and parsing.
-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
module Coalpit.DSV (showDSV, readDSV) where
import Data.List
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Void
import Coalpit.Core
composeDSVLine :: Char -> [String] -> String
composeDSVLine fs = intercalate [fs] . map escapeVal
where
escapeVal :: String -> String
-- not great, but will do for now
escapeVal s = let inner = show s
in if fs `elem` inner
then inner
else init $ tail inner
-- | Composes DSV out of values.
composeDSV :: Char
-- ^ Field separator.
-> [[String]]
-- ^ Lines of values.
-> String
composeDSV fs = unlines . map (composeDSVLine fs)
pStr :: Char -> Parsec Void String String
pStr fs = do
s <- try (between (char '"') (char '"')
(concat <$> many (string "\\\\"
<|> string "\\\""
<|> pure <$> notChar '"')))
<|> many (notChar fs)
case reads (concat ["\"", s, "\""]) of
[(str, "")] -> pure str
other -> fail $ "Failed to read a string: " ++ show other ++ "(" ++ s ++ ")"
pDSVLine :: Char -> Parsec Void String [String]
pDSVLine fs = pStr fs `sepBy` char fs
-- | Parses values out of DSV.
parseDSV :: Char
-- ^ Field separator
-> String
-- ^ A string containing lines.
-> [Either String [String]]
parseDSV fs = map parseLine . lines
where parseLine :: String -> Either String [String]
parseLine l = case parse (pDSVLine fs) "line" l of
Left err -> Left $ parseErrorPretty err
Right x -> Right x
-- | Shows values in DSV format.
showDSV :: Coalpit a => Options -> [a] -> String
showDSV opt = composeDSV (fieldSeparator opt) . map (toArgs opt)
-- | Reads values from DSV format.
readDSV :: Coalpit a => Options -> String -> [Either String a]
readDSV opt = map (>>= fromArgs opt) . parseDSV (fieldSeparator opt)
|
