module Components.Parsers.VariablesParser (parseVariables) where

import Control.Exception (throw)
import Text.JSON (JSValue,JSObject,fromJSObject,Result(Ok,Error),encode,decode)
import Data.List (foldl')
import Model.ServerExceptions (
        QueryException(
            MissingVariableValueException,
            ReadVariablesException,
            EmptyQueryException,
            VariablesSyntaxException,
            InvalidVariableTypeException
        )
    )


-- 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,Nothing) [] =  throw MissingVariableValueException
findVariableValue (vname,vtype,Just vval) [] = (vname,vtype,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,val) | (nam,typ,Just 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 False acc1 typ acc2 acc3 (':':t) = separateVariables True (removeTailSpaces acc1) False [] [] $ removeLeadingSpaces t
separateVariables False acc1 typ acc2 acc3 (h:t) = separateVariables False (acc1++[h]) typ acc2 acc3 t
separateVariables var acc1 False acc2 acc3 (',':t) = if (isValidBaseType finalizedType)==True then (acc1,finalizedType,Nothing):separateVariables False [] False [] [] (removeLeadingSpaces t) else throw InvalidVariableTypeException
  where
    finalizedType = removeTailSpaces acc2
separateVariables var acc1 False acc2 acc3 ('=':t)
    | isValidBaseType finalizedType = separateVariables var acc1 True finalizedType [] $ removeLeadingSpaces t
    | otherwise = throw InvalidVariableTypeException
  where
    finalizedType = removeTailSpaces acc2
separateVariables var acc1 False acc2 acc3 (h:t) = separateVariables var acc1 False (acc2++[h]) [] t
separateVariables var acc1 typ acc2 acc3 (',':t) = (acc1,acc2,if (length finalizedValue)==0 then Nothing else Just $ finalizedValue):(separateVariables False [] False [] [] $ removeLeadingSpaces t)
  where
    finalizedValue = removeTailSpaces acc3
separateVariables var acc1 typ acc2 acc3 (h:t) = separateVariables var acc1 typ acc2 (acc3++[h]) t
removeTailSpaces :: String -> String
removeTailSpaces str = reverseString $ removeLeadingSpaces $ reverseString str
reverseString :: String -> String
reverseString str = foldl (\y x->x:y) [] str
isValidBaseType :: String -> Bool
isValidBaseType "Text" = True
isValidBaseType "ByteString" = True
isValidBaseType "Int" = True
isValidBaseType "Double" = True
isValidBaseType "Rational" = True
isValidBaseType "Bool" = True
isValidBaseType "Day" = True
isValidBaseType "TimeOfDay" = True
isValidBaseType "UTCTime" = True
isValidBaseType _ = False