module Components.Parsers.VariablesParser where
import Text.JSON
import Data.Maybe
import qualified Control.Exception as E
import Model.ServerExceptions
parseVariables :: String -> String -> [(String,String,String)]
parseVariables var qry = filterToDesired (parseVariableValuePairs var) (getVariableTypePairs qry)
filterToDesired :: [(String,String)] -> [(String,String,Maybe String)] -> [(String,String,String)]
filterToDesired _ [] = []
filterToDesired [] tvar = if (anyMaybeMissingValues tvar)==True then E.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 E.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]
parseVariableValuePairs :: String -> [(String,String)]
parseVariableValuePairs [] = []
parseVariableValuePairs vars = castValues $ fromJSObject $ checkVariables (decode vars :: Result (JSObject JSValue))
checkVariables :: Result (JSObject JSValue) -> JSObject JSValue
checkVariables (Error str) = E.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 [] = E.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) = E.throw VariablesSyntaxException
| (elem ')' epilogue) = E.throw VariablesSyntaxException
| otherwise = []
where
epilogue = getQueryEpilogue qry
getQueryEpilogue :: String -> String
getQueryEpilogue [] = E.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 _ [] _ _ _ [] = []
separateVariables _ var _ [] _ [] = E.throw VariablesSyntaxException
separateVariables _ var _ typ [] [] = if (isValidBaseType typ) then (var,typ,Nothing):[] else E.throw InvalidVariableTypeException
separateVariables _ var _ typ dval [] = if (isValidBaseType typ) then (var,typ,Just $ removeTailSpaces dval):[] else E.throw InvalidVariableTypeException
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 E.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) = E.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"]