module CSVQLBuiltins where

import System.IO
import Data.Char
import Text.CSV

import CSVQLTokens
import CSVQLGrammar
import CSVQLEval

importFromCsv :: BuiltIn
importFromCsv (gamma, String filename) = do
    input <- readFile filename
    let csv = parseCSV filename input
    table <- either handleError readCsv csv
    return (gamma, table)

handleError csv = error $ "could not parse csv:\n" ++ show csv
readCsv csv = do
    let arity = length (head csv)
    case csv of
        [[""]] -> return (Table (Int 1) Null)
        _ -> return (Table (Int arity) (toListBody (map (toRow . makeRowList) csv)))

makeRowList :: Record -> E
makeRowList [] = Null
makeRowList [x] = String (removeWhitespace x)
makeRowList (x:xs) = ListBody (String (removeWhitespace x)) (makeRowList xs)

removeWhitespace :: String -> String
removeWhitespace = reverse . rmWhite . reverse . rmWhite

rmWhite :: String -> String
rmWhite [] = []
rmWhite [x] = [x]
rmWhite (x:xs) | x == ' ' || x == '\t' = rmWhite xs
            | otherwise = x : xs

toRow :: E -> E
toRow = Row

toListBody :: [E] -> E
toListBody [] = Null
toListBody [x] = x
toListBody (x:[(Row (String ""))]) = x
toListBody (x:xs) = ListBody x (toListBody xs)

ownPrint :: BuiltIn
ownPrint (g, e) = do
    x <- testIO e
    putStrLn ""
    return (g, x)
    
createTable :: BuiltIn
createTable (gamma, Int x) = return (gamma, Table (Int x) Null)
createTable (gamma, exp) = do
    case exp of
        Int x -> return (gamma, Table (Int x) Null)
        _ -> error "invalid type"

addRowToTable :: BuiltIn
addRowToTable (gamma, ListBody (Table (Int arity) rows) (ListBody (String tableName) row)) = do
    let newGamma = removeVar gamma [] tableName
    (_, row') <- evalExpr [] [] (gamma, row)
    newTable <- addRow' (ListBody (Table (Int arity) rows) row')
    return ((tableName, newTable):newGamma, Bool True)
    where
        addRow' :: E -> IO E
        addRow' (ListBody (Table (Int _) Null) row@(Row e)) = return (Table (Int (lengthList row)) row)
        -- addRow' (ListBody (Table (Int arity) Null) row@(Row e))
        --     | lengthList row == arity = do
        --         return (Table (Int arity) row)
        --     | otherwise = error "incorrect arity"
        addRow' (ListBody (Table (Int arity) rows) row@(Row e))
            | lengthList row == arity = do
                let newRows = appendToList rows row
                return (Table (Int arity) newRows)
            | otherwise = error "incorrect arity"
        addRow' (ListBody (Table (Int _) Null) row) = return (Table (Int (lengthList row')) row')
            where row' = Row (eToString row)
        addRow' (ListBody (Table (Int arity) rows) row)
            | lengthList (Row (eToString row)) == arity = do
                let newRows = appendToList rows (Row (eToString row))
                return (Table (Int arity) newRows)
            | otherwise = error "incorrect arity"
addRowToTable (gamma, thing) = error "incorrect arguments for addRowToTable (should be values to add equal to arity of table seperated by a comma or a Row)"

getIndex :: BuiltIn
getIndex (g, e) = do
    case e of
        (ListBody (Table _ items) (Int index)) -> return (g, fetchExp index items)
        (ListBody (Row items) (Int index)) -> return (g, fetchExp index items)
        (ListBody (List items) (Int index)) -> return (g, fetchExp index items)
        _ -> error "invalid arguments"
    where
        fetchExp :: Int -> E -> E
        fetchExp 0 (ListBody e1 e2) = e1
        fetchExp 0 e1 = e1
        fetchExp n (ListBody _ e2) = fetchExp (n - 1) e2
        fetchExp n _ = error "index out of range"
    
-- function definition of isEmpty
isEmpty :: BuiltIn
isEmpty (g, e) = return (g, eIsEmpty e)

-- function definition of length
eLength :: BuiltIn
eLength (g, e) = return (g, Int (lengthList e))

getArity :: BuiltIn
getArity (g, Table (Int x) _) = return (g, Int x)
getArity (g, Row x) = return (g, Int (lengthList x))
getArity (_, _) = error "cannot get arity of non-row or table"

testIO :: E -> IO E
testIO (String x) = do
    putStr x
    return (Bool True)
testIO (Int x) = do
    putStr $ show x
    return (Bool True)
testIO (List x) = do
    putStr "["
    bool <- testIO x
    putStr "]"
    return bool
testIO (Table width rows) = do
    putStrLn ("Table with width: " ++ show width)
    testIO rows
testIO (Row x) = do
    putStr "("
    bool <- testIO x
    putStr ")"
    return bool
testIO (ListBody x next) = do
    bool <- testIO x
    putStr ", "
    testIO next
testIO (Bool x) = do
    putStr (show x)
    return (Bool True)
testIO Null = do
    putStr "null"
    return (Bool True)
testIO e = error $ show e

printButForReal :: BuiltIn
printButForReal (g, String x) = do
    putStr $ show x
    return (g, Bool True)
printButForReal (g, Bool x) = do
    putStr $ show x
    return (g, Bool True)
printButForReal (g, Int x) = do
    putStr $ show x
    return (g, Bool True)
printButForReal (g, Null) = do
    putStr "null"
    return (g, Bool True)
printButForReal (g, List x) = do
    putStr "["
    bool <- printButForReal (g, x)
    putStr "]"
    return bool
printButForReal (g, Table _ Null) = return (g, Null)
printButForReal (g, t@(Table arity rows)) = do
    let rows' = sort t
    case rows' of
        (List rows'') -> do
            printRows rows'
            return (g, Null)
            where
                printRows (ListBody row rows) = do
                    printRow row
                    printRows rows
                printRows row = printRow row
        (Row rows'') -> do
            printRow rows''
            return (g, Null)
        (Table _ rows'') -> do
            printRows rows''
            return (g, Null)
            where
                printRows (ListBody row rows) = do
                    printRow row
                    putStr "\n"
                    printRows rows
                printRows row = printRow row
        _ -> do
            error "cannot print sorted version of this type"
            return (g, Null)
printButForReal (g, Row x) = do
    printRow x
    return (g, Null)

printRow :: E -> IO ()
printRow (Row e1) = do
    printRow' e1
    where
        printRow' (ListBody (String x) e2) = do
            putStr x
            putStr ","
            printRow' e2
        printRow' (String x) = putStr x
printRow e = putStr ""

eMax :: BuiltIn
eMax (gamma, ListBody a b) = return (gamma,maxExpr a b)

eMin :: BuiltIn
eMin (gamma, ListBody a b) = return (gamma,minExpr a b)

printcsv :: BuiltIn
printcsv (g, Table _ Null) = return (g, Null)
printcsv (g, Table arity rows) = do
    let rows' = sort rows
    case rows' of
        (List rows'') -> do
            printRows rows'
            return (g, Null)
            where
                printRows (ListBody row rows) = do
                    printRow row
                    printRows rows
                printRows row = printRow row
        (Row rows'') -> do
            printRow rows''
            return (g, Null)
        (Table _ rows'') -> do
            printRows rows''
            return (g, Null)
            where
                printRows (ListBody row rows) = do
                    printRow row
                    printRows rows
                printRows row = printRow row
        _ -> do
            error "cannot print sorted version of this type"
            return (g, Null)