module Lsql.Csv.Lang.From.CsvParser
(Assignment (CoreCsv, NamedCsv), parseFile) where
import Lsql.Csv.Core.Tables
import Lsql.Csv.Core.Symbols
import Lsql.Csv.Lang.Args
import Lsql.Csv.Lang.Options
import Lsql.Csv.Utils.BracketExpansion
import Data.List
import Data.Char
import qualified Data.Text as T
import System.IO
import Text.Parsec
import Text.Parsec.Prim
import Text.Parsec.Combinator
import Text.Parsec.Text
import Text.Parsec.Char
data Assignment =
CoreCsv
Int
String
Program
[Option]
|
NamedCsv
String
Assignment
quoteP :: Char -> Parser String
quoteP :: Char -> Parser String
quoteP Char
second_delimiter = do
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
second_delimiter
String
ret <- ParsecT Text () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(ParsecT Text () Identity Char -> Parser String)
-> ParsecT Text () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ ((ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text () Identity Char
doubleQuoteP) ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
second_delimiter])
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
second_delimiter
String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
ret
where
doubleQuoteP :: Parser Char
doubleQuoteP :: ParsecT Text () Identity Char
doubleQuoteP = do
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
second_delimiter
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
second_delimiter
Char -> ParsecT Text () Identity Char
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
second_delimiter
normalCellP :: Char -> Parser String
normalCellP :: Char -> Parser String
normalCellP Char
delimiter = ParsecT Text () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(ParsecT Text () Identity Char -> Parser String)
-> ParsecT Text () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\n', Char
delimiter]
cellP :: Char -> Char -> Parser String
cellP :: Char -> Char -> Parser String
cellP Char
delimiter Char
sec_delimiter = (Parser String -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try(Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ Char -> Parser String
quoteP Char
sec_delimiter) Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Parser String
normalCellP Char
delimiter)
rowP :: Char -> Char -> Parser [String]
rowP :: Char -> Char -> Parser [String]
rowP Char
delimiter Char
sec_delimiter = do
[String]
ret_non_term <- Parser String -> Parser [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(Parser String -> Parser [String])
-> Parser String -> Parser [String]
forall a b. (a -> b) -> a -> b
$ Parser String -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser String
not_term_p
String
ret_term <- Parser String
term_p
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
[String] -> Parser [String]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return([String] -> Parser [String]) -> [String] -> Parser [String]
forall a b. (a -> b) -> a -> b
$ [String]
ret_non_term [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
ret_term]
where
cell_p :: Parser String
cell_p = Char -> Char -> Parser String
cellP Char
delimiter Char
sec_delimiter
not_term_p :: Parser String
not_term_p :: Parser String
not_term_p = do
String
ret <- Parser String
cell_p
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
delimiter
String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
ret
term_p :: Parser String
term_p :: Parser String
term_p = do
String
ret <- Parser String
cell_p
String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
ret
tableP :: Char -> Char -> Parser [[String]]
tableP :: Char -> Char -> Parser [[String]]
tableP Char
delimiter Char
sec_delimiter = Parser [String] -> Parser [[String]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1(Parser [String] -> Parser [[String]])
-> Parser [String] -> Parser [[String]]
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Parser [String]
rowP Char
delimiter Char
sec_delimiter
readValue :: String -> Value
readValue :: String -> Value
readValue String
val
| String -> Bool
isTrue String
val = Bool -> Value
BoolValue Bool
True
| String -> Bool
isFalse String
val = Bool -> Value
BoolValue Bool
False
| String -> Bool
isInteger String
val = Int -> Value
IntValue (String -> Int
forall a. Read a => String -> a
read String
val)
| String -> Bool
isDouble String
val = Double -> Value
DoubleValue (String -> Double
forall a. Read a => String -> a
read String
val)
| Bool
otherwise = String -> Value
StringValue String
val
where
isTrue :: String -> Bool
isTrue String
s = String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true"
isFalse :: String -> Bool
isFalse String
s = String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"false"
isInteger :: String -> Bool
isInteger String
s = case ReadS Integer
forall a. Read a => ReadS a
reads String
s :: [(Integer, String)] of
[(Integer
_, String
"")] -> Bool
True
[(Integer, String)]
_ -> Bool
False
isDouble :: String -> Bool
isDouble String
s = case ReadS Double
forall a. Read a => ReadS a
reads String
s :: [(Double, String)] of
[(Double
_, String
"")] -> Bool
True
[(Double, String)]
_ -> Bool
False
check_square_data :: [[a]] -> [[a]]
check_square_data :: forall a. [[a]] -> [[a]]
check_square_data [] = []
check_square_data ([a]
x : [[a]]
rest) = [a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> Int -> [[a]] -> [[a]]
forall a. Int -> Int -> [[a]] -> [[a]]
check_square_data_n Int
2 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x) [[a]]
rest
check_square_data_n :: Int -> Int -> [[a]] -> [[a]]
check_square_data_n :: forall a. Int -> Int -> [[a]] -> [[a]]
check_square_data_n Int
_ Int
_ [] = []
check_square_data_n Int
line_number Int
n ([a]
x : [[a]]
rest) =
if [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n then
[a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> Int -> [[a]] -> [[a]]
forall a. Int -> Int -> [[a]] -> [[a]]
check_square_data_n (Int
line_numberInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n [[a]]
rest
else
String -> [[a]]
forall a. HasCallStack => String -> a
error(String -> [[a]]) -> String -> [[a]]
forall a b. (a -> b) -> a -> b
$ String
"Invalid CSV file. Bad number of columns at line " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line_number String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
". Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
buildTableFromIn :: [String] -> Bool -> [[String]] -> Table
buildTableFromIn :: [String] -> Bool -> [[String]] -> Table
buildTableFromIn [String]
table_names Bool
named [[String]]
in_str =
[String] -> [[String]] -> [[Value]] -> Table
buildTable [String]
table_names [[String]]
expanded_names [[Value]]
in_data
where
expanded_names :: [[String]]
expanded_names :: [[String]]
expanded_names = [[ String
table_name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
col_name
| String
col_name <- [String]
col_names, String
table_name <- [String]
table_names]
| [String]
col_names <- [[String]]
names]
names :: [[String]]
names :: [[String]]
names
|Bool
named = ((String, String) -> [String]) -> [(String, String)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,String
y) -> [String
x,String
y]) ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[String]] -> [String]
forall a. HasCallStack => [a] -> a
head [[String]]
in_str)([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [Integer
1..])
|Bool
otherwise = ([Integer] -> [String]) -> [[Integer]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show) ([[Integer]] -> [[String]]) -> [[Integer]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [[Integer]]
forall a. Eq a => [a] -> [[a]]
group [Integer
1..]
c_in_str :: [[String]]
c_in_str :: [[String]]
c_in_str = [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
check_square_data [[String]]
in_str
in_data :: [[Value]]
in_data :: [[Value]]
in_data
|Bool
named = ([String] -> [Value]) -> [[String]] -> [[Value]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Value) -> [String] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map String -> Value
readValue)([[String]] -> [[Value]]) -> [[String]] -> [[Value]]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [[String]]
forall a. HasCallStack => [a] -> [a]
tail [[String]]
c_in_str
|Bool
otherwise = ([String] -> [Value]) -> [[String]] -> [[Value]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Value) -> [String] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map String -> Value
readValue)([[String]] -> [[Value]]) -> [[String]] -> [[Value]]
forall a b. (a -> b) -> a -> b
$ [[String]]
c_in_str
parseFile :: Assignment -> IO Table
parseFile :: Assignment -> IO Table
parseFile Assignment
assignment = do
String
file_content <- IO String
load_input
Table -> IO Table
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(Table -> IO Table) -> Table -> IO Table
forall a b. (a -> b) -> a -> b
$ String -> Table
parseTable (String
file_content)
where
load_input :: IO String
load_input :: IO String
load_input
| String
file_name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" = IO String
getContents
| Bool
otherwise = String -> IO String
readFile String
file_name
(Program String
_ Char
delimiter Char
second_delimiter Bool
first_line_names) = Program
finalProgram
where
finalProgram :: Program
finalProgram :: Program
finalProgram = Program -> [Option] -> Program
reloadOpts Program
in_program [Option]
opts
(CoreCsv Int
index String
file_name Program
in_program [Option]
opts) = Assignment -> Assignment
coreAssignment Assignment
assignment
where
coreAssignment :: Assignment -> Assignment
coreAssignment :: Assignment -> Assignment
coreAssignment (NamedCsv String
_ Assignment
core) = Assignment
core
coreAssignment Assignment
core = Assignment
core
tableNames :: [String]
tableNames :: [String]
tableNames = Assignment -> [String]
tableNamesGet Assignment
assignment
where
tableNamesGet :: Assignment -> [String]
tableNamesGet :: Assignment -> [String]
tableNamesGet (CoreCsv Int
index String
file_name Program
_ [Option]
_ ) = [Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
index, String
file_name]
tableNamesGet (NamedCsv String
next_name Assignment
rest) = String
next_name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Assignment -> [String]
tableNamesGet Assignment
rest
parseTable :: String -> Table
parseTable :: String -> Table
parseTable String
content =
case Parser [[String]] -> String -> Text -> Either ParseError [[String]]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Char -> Char -> Parser [[String]]
tableP Char
delimiter Char
second_delimiter) String
file_name(Text -> Either ParseError [[String]])
-> Text -> Either ParseError [[String]]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
content of
Left ParseError
err -> String -> Table
forall a. HasCallStack => String -> a
error(String -> Table) -> String -> Table
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
Right [[String]]
parsed -> [String] -> Bool -> [[String]] -> Table
buildTableFromIn [String]
tableNames Bool
first_line_names [[String]]
parsed