module Components.Parsers.VariablesParser where import Text.JSON import Data.Maybe import qualified Control.Exception as E import Model.ServerExceptions -- 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 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] -- 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) = 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 _ [] _ _ _ [] = [] -- no variables separateVariables _ var _ [] _ [] = E.throw VariablesSyntaxException -- variable without type separateVariables _ var _ typ [] [] = if (isValidBaseType typ) then (var,typ,Nothing):[] else E.throw InvalidVariableTypeException -- variable without default value separateVariables _ var _ typ dval [] = if (isValidBaseType typ) then (var,typ,Just $ removeTailSpaces dval):[] else E.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 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"]