module Components.Parsers.VariablesParser where

import Model.ServerExceptions (
        QueryException(
            MissingVariableValueException,
            ReadVariablesException,
            VariablesSyntaxException,
            EmptyQueryException,
            VariablesSyntaxException,
            InvalidVariableTypeException
        )
    )
import Control.Exception (throw)
import Text.JSON (JSValue,JSObject,fromJSObject,Result(Ok,Error),encode,decode)
import Data.Maybe (fromJust,Maybe(Nothing,Just))


-- with a variables string and query string, we want the query variables, the type, and the value
parseVariables :: String -> String -> [(String,String,String)]
parseVariables var qry = filterToDesired (parseVariableValuePairs var) (getVariableTypePairs qry)
-- with variable-values and variable-types, we want query variable-type-values
filterToDesired :: [(String,String)] -> [(String,String,Maybe String)] -> [(String,String,String)]
filterToDesired _ [] = []
filterToDesired [] tvar = if (anyMaybeMissingValues tvar)==True then throw MissingVariableValueException else (getDefaultValues tvar)
filterToDesired vvar tvars = [findVariableValue tvar vvar | tvar<-tvars]
findVariableValue :: (String,String,Maybe String) -> [(String,String)] -> (String,String,String)
findVariableValue (vname,vtype,vval) [] = if vval==Nothing then throw MissingVariableValueException else (vname,vtype,fromJust vval :: String)
findVariableValue (vname1,vtype,vval1) ((vname2,vval2):t) = if (vname1==vname2) then (vname1,vtype,vval2) else (findVariableValue (vname1,vtype,vval1) t)
anyMaybeMissingValues :: [(String,String,Maybe String)] -> Bool
anyMaybeMissingValues vars = foldr (\(nam,typ,val) y -> (val==Nothing)||y) False vars
getDefaultValues :: [(String,String,Maybe String)] -> [(String,String,String)]
getDefaultValues vars = [(nam,typ,fromJust val) | (nam,typ,val)<-vars]
-- from given variables argument, we want variable-values
parseVariableValuePairs :: String -> [(String,String)]
parseVariableValuePairs [] = []
parseVariableValuePairs vars = castValues $ fromJSObject $ checkVariables (decode vars :: Result (JSObject JSValue))
checkVariables :: Result (JSObject JSValue) -> JSObject JSValue
checkVariables (Error str) = throw ReadVariablesException
checkVariables (Ok vars) = vars
castValues :: [(String,JSValue)] -> [(String,String)]
castValues vars = [("$"++(removeQuotations name),encode val) | (name,val)<-vars]
removeQuotations :: String -> String
removeQuotations (h1:h2:t) = if (h1=='\\')&&(h2=='"') then (removeQuotations t) else h1:(removeQuotations (h2:t))
removeQuotations str = str
getVariableTypePairs :: String -> [(String,String,Maybe String)]
getVariableTypePairs [] = throw EmptyQueryException
getVariableTypePairs qry
    | (elem '(' epilogue)&&(elem ')' epilogue) = separateVariables False "" False "" "" $ removeLeadingSpaces $ foldl (\y x -> if x=='(' then [] else y++[x]) [] $ foldr (\x y -> if x==')' then [] else x:y) [] epilogue
    | (elem '(' epilogue) = throw VariablesSyntaxException
    | (elem ')' epilogue) = throw VariablesSyntaxException
    | otherwise = []
  where
    epilogue = getQueryEpilogue qry
getQueryEpilogue :: String -> String
getQueryEpilogue [] = throw EmptyQueryException
getQueryEpilogue (h:t) = if (h=='{') then [] else h:(getQueryEpilogue t)
removeLeadingSpaces :: String -> String
removeLeadingSpaces (h:t) = if (h==' ') then removeLeadingSpaces t else (h:t)
separateVariables :: Bool -> String -> Bool -> String -> String -> String -> [(String,String,Maybe String)]
separateVariables _ [] _ _ _ [] = []  -- no variables
separateVariables _ var _ [] _ [] = throw VariablesSyntaxException  -- variable without type
separateVariables _ var _ typ [] [] = if (isValidBaseType typ) then (var,typ,Nothing):[] else throw InvalidVariableTypeException  -- variable without default value
separateVariables _ var _ typ dval [] = if (isValidBaseType typ) then (var,typ,Just $ removeTailSpaces dval):[] else throw InvalidVariableTypeException  -- variable with default value
separateVariables var acc1 typ acc2 acc3 (h:t)
    | (var==False)&&(h/=':') = separateVariables var (acc1++[h]) typ acc2 acc3 t
    | (var==False) = separateVariables True (removeTailSpaces acc1) False [] [] (removeLeadingSpaces t)
    | (typ==False)&&(h==',') = if (isValidBaseType finalizedType)==True then (acc1,finalizedType,Nothing):(separateVariables False [] False [] [] (removeLeadingSpaces t)) else throw InvalidVariableTypeException
    | (typ==False)&&(h/='=') = separateVariables var acc1 typ (acc2++[h]) [] t
    | (typ==False)&&(isValidBaseType finalizedType) = separateVariables var acc1 True finalizedType [] (removeLeadingSpaces t)
    | (typ==False) = throw InvalidVariableTypeException
    | (h/=',') = separateVariables var acc1 typ acc2 (acc3++[h]) t
    | otherwise = (acc1,acc2,if (length finalizedValue)==0 then Nothing else (Just $ finalizedValue)):(separateVariables False [] False [] [] $ removeLeadingSpaces t)
  where
    finalizedType = removeTailSpaces acc2
    finalizedValue = removeTailSpaces acc3
removeTailSpaces :: String -> String
removeTailSpaces str = reverseString $ removeLeadingSpaces $ reverseString str
reverseString :: String -> String
reverseString str = foldl (\y x->x:y) [] str
isValidBaseType :: String -> Bool
isValidBaseType typ = elem typ ["Text","ByteString","Int","Double","Rational","Bool","Day","TimeOfDay","UTCTime"]