{-|
This module contains the CsvParser called by the `parseFile`, which loads input CSV files.
-}

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

-- Csv Index Path Program [Option]
-- | A data structure representing one input file
data Assignment = 
  -- | An input file without any assigned names
  CoreCsv 
    Int -- ^ The index of the file (indexing from 1)
    String -- ^ The path to the file
    Program -- ^ A potentially altered `Program` for the given CSV file
    [Option] -- ^ Parsed additional `Option`s for the given CSV file
    |

  -- | An input file with an assigned name
  NamedCsv 
    String -- ^ The assign name
    Assignment -- ^ The rest of the 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

-- | Parses CSV file described in the given `Assignment`.
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