summaryrefslogtreecommitdiff
path: root/src/Components/Parsers/VariablesParser.hs
blob: a09cb1d56469d0296f0b29dcf4cb2301a84a6fe5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
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"]