summaryrefslogtreecommitdiff
path: root/src/Components/Parsers/QueryParser.hs
blob: 5e4018d7406c22b3cd6a963f1a0047d2a22c0973 (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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
module Components.Parsers.QueryParser (processString,validateQuery,parseStringToObjects) where


import qualified Control.Exception as E
import Model.ServerExceptions
import Model.ServerObjectTypes
import Components.ObjectHandlers.ObjectsHandler (readServerObject)


{-----Step 1. PROCESSING-----}
processString :: String -> String
processString str = removeComments $ removeLinebreaks str
-- REQUIREMENTS: Windows and Mac are one of \r\n, \n, or \r to make a new line break. Another OS is maybe different.
removeComments :: String -> String
removeComments str = removeCommentsHelper str False
removeCommentsHelper :: String -> Bool -> String
removeCommentsHelper [] _ = []
removeCommentsHelper (h:[]) _ = h:[]
removeCommentsHelper (h1:h2:t) mde
 | h1=='#' = removeCommentsHelper (h2:t) True
 | h1=='\r' = '\r':removeCommentsHelper (h2:t) False
 | h1=='\n' = '\n':removeCommentsHelper (h2:t) False
 | h1=='\\'&&h2=='r' = '\\':'r':removeCommentsHelper t False
 | h1=='\\'&&h2=='n' = '\\':'n':removeCommentsHelper t False
 | mde==True = removeCommentsHelper (h2:t) mde
 | otherwise = h1:(removeCommentsHelper (h2:t) mde)
-- NOTE: this is used with only the textarea field of forms since they are giving line breaks these combinations...
removeLinebreaks :: String -> String
removeLinebreaks [] = []
removeLinebreaks (h:[])
 | h=='\n'   = ' ':[]
 | h=='\r'   = ' ':[]
 | otherwise = h:[]
removeLinebreaks (h1:h2:t)
 | h1=='\\'&&h2=='r' = ' ':removeLinebreaks t
 | h1=='\\'&&h2=='n' = ' ':removeLinebreaks t
 | otherwise = h1:removeLinebreaks (h2:t)


{-----Step 2. VALIDATION-----}
validateQuery :: String -> Bool
validateQuery [] = False
validateQuery str = (validateBracketLocationQuery str)&&(validateNoEmptyBrackets str)
-- this is first validation to check that we have equal opening/closing brackets, and we do not close before opening
validateBracketLocationQuery :: String -> Bool
validateBracketLocationQuery str = validateBracketLocationQueryHelper str 0 0
validateBracketLocationQueryHelper :: String -> Int -> Int -> Bool
validateBracketLocationQueryHelper [] x y = (x==y)
validateBracketLocationQueryHelper (h:t) o c
 | h=='{'       = validateBracketLocationQueryHelper t (o+1) c
 | h=='}'&&o<=c = False
 | h=='}'       = validateBracketLocationQueryHelper t o (c+1)
 | otherwise    = validateBracketLocationQueryHelper t o c
validateNoEmptyBrackets :: String -> Bool
validateNoEmptyBrackets str = validateNoEmptyBracketsHelper str "" []
validateNoEmptyBracketsHelper :: String -> String -> [String] -> Bool
validateNoEmptyBracketsHelper [] acc nst = (length nst)<1
validateNoEmptyBracketsHelper (a:b) acc []
 | a=='{' = validateNoEmptyBracketsHelper b [] [acc]
 | a=='}' = False
 | a==' ' = validateNoEmptyBracketsHelper b acc []
 | otherwise = validateNoEmptyBracketsHelper b (acc++[a]) []
validateNoEmptyBracketsHelper (a:b) acc (i:j)
 | a==' ' = validateNoEmptyBracketsHelper b acc (i:j)
 | a=='{'&&(length acc)==0 = False
 | a=='{'                  = validateNoEmptyBracketsHelper b [] (acc:i:j)
 | a=='}'&&(length acc)==0 = False
 | a=='}'                  = validateNoEmptyBracketsHelper b i j
 | otherwise               = validateNoEmptyBracketsHelper b (acc++[a]) (i:j)


{-----Step 3. PARSING-----}
parseStringToObjects :: String -> [(String,[String])] -> RootObjects
parseStringToObjects [] _ = E.throw EmptyQueryException
parseStringToObjects str svrobjs = composeObjects query svrobjs
  where
    (qry,fmts) = getQueryAndFragments str
    fragments = parseFragments fmts svrobjs
    query = substituteFragments qry fragments svrobjs
-- REQUIRES: curly braces are in correct order
getQueryAndFragments :: String -> (String, String)
getQueryAndFragments str = getQueryAndFragmentsHelper str 0 False "" ""
getQueryAndFragmentsHelper :: String -> Int -> Bool -> String -> String -> (String, String)
getQueryAndFragmentsHelper [] _ _ x y = (x, y)
getQueryAndFragmentsHelper (h:t) l m q f
 | h=='{'&&m==False = getQueryAndFragmentsHelper t (l+1) m (q++[h]) f
 | h=='}'&&l==1&&m==False = getQueryAndFragmentsHelper t (l-1) True (q++[h]) f
 | h=='}'&&m==False = getQueryAndFragmentsHelper t (l-1) m (q++[h]) f
 | m==False = getQueryAndFragmentsHelper t l m (q++[h]) f
 | otherwise = getQueryAndFragmentsHelper t l m q (f++[h])
data Fragment = Fragment
    { name :: String
    , targetObject :: ServerObject
    , replacement :: String
    } deriving Show
parseFragments :: String -> [(String,[String])] -> [Fragment]
parseFragments str svrobjs = parseFragmentsHelper str "" 0 [] svrobjs
parseFragmentsHelper :: String -> String -> Int -> [Fragment] -> [(String,[String])] -> [Fragment]
parseFragmentsHelper [] _ _ rslt _ = rslt
parseFragmentsHelper (h:t) acc l rslt svrobjs
 | h=='{' = parseFragmentsHelper t (acc++[h]) (l+1) rslt svrobjs
 | h=='}'&&l==1 = parseFragmentsHelper t [] (l-1) ((createFragment acc svrobjs):rslt) svrobjs -- completed one fragment
 | h=='}' = parseFragmentsHelper t (acc++[h]) (l-1) rslt svrobjs  -- closed a nested object
 | otherwise = parseFragmentsHelper t (acc++[h]) l rslt svrobjs
-- with a fragment string that is without closing curly braces, we want a fragments
createFragment :: String -> [(String,[String])] -> Fragment
createFragment str svrobjs = createFragmentHelper str 0 [] False False False False "" "" svrobjs
{-
    d is for declaration
    n is for name
    a is for arrangement
    o is for object
    b is for 
-}
createFragmentHelper :: String -> Int -> String -> Bool -> Bool -> Bool -> Bool -> String -> String -> [(String,[String])] -> Fragment
createFragmentHelper [] l acc d n a o rst1 rst2 svrobjs = if (l==1&&d==True&&n==True&&a==True&&o==True) then Fragment { name=rst1,targetObject=(readServerObject rst2 svrobjs),replacement=acc } else E.throw ParseFragmentException
createFragmentHelper (h:t) l acc d n a o rst1 rst2 svrobjs
 | d==False&&(h=='f'||h=='r'||h=='a'||h=='g'||h=='m'||h=='e'||h=='n'||h=='t') = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs
 | d==False&&h==' '&&(length acc)>0&&acc=="fragment" = createFragmentHelper t l [] True n a o rst1 rst2 svrobjs
 | d==False&&h==' '&&(length acc)>0 = E.throw ParseFragmentException
 | d==False&&h==' '&&(length acc)<1 = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs
 | d==False = E.throw ParseFragmentException
 | n==False&&h==' '&&(length acc)==0 = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs
 | n==False&&h==' '&&(length acc)>0 = createFragmentHelper t l [] d True a o acc rst2 svrobjs
 | n==False&&(isValidFragmentNameChar h)==False = E.throw ParseFragmentException
 | n==False = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs
 | a==False&&h==' '&&(length acc)==0 = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs
 | a==False&&h==' '&&(length acc)>0&&(acc=="on") = createFragmentHelper t l [] d n True o rst1 rst2 svrobjs
 | a==False&&h==' '&&(length acc)>0 = E.throw ParseFragmentException
 | a==False&&(h=='o'||h=='n') = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs
 | a==False = E.throw ParseFragmentException
 | o==False&&((length acc)==0)&&(((fromEnum h)>=97)||((fromEnum h)<=122)) = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs
 | o==False&&((length acc)==0)&&(h==' ') = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs
 | o==False&&((length acc)==0) = E.throw ParseFragmentException
 | o==False&&h==' ' = createFragmentHelper t l [] d n a True rst1 acc svrobjs
 | o==False&&h=='{' = createFragmentHelper t (l+1) [] d n a True rst1 acc svrobjs
 | o==False&&(isValidIdentifierChar h) = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs
 | o==False = E.throw ParseFragmentException
 | h==' '&&l==0 = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs
 | h=='{'&&l==0 = createFragmentHelper t (l+1) [] d n a o rst1 rst2 svrobjs
 | l==0 = E.throw ParseFragmentException
 | (isValidIdentifierChar h)||h==' ' = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs
 | h=='{' = createFragmentHelper t (l+1) (acc++[h]) d n a o rst1 rst2 svrobjs
 | h=='}' = createFragmentHelper t (l-1) (acc++[h]) d n a o rst1 rst2 svrobjs
 | otherwise = E.throw ParseFragmentException
isValidFragmentNameChar :: Char -> Bool
isValidFragmentNameChar c = ((fromEnum c)>=65&&(fromEnum c)<=90)||((fromEnum c)>=97&&(fromEnum c)<=122)||((fromEnum c)>=48&&(fromEnum c)<=57)||((fromEnum c)==95)
isValidIdentifierChar :: Char -> Bool
isValidIdentifierChar c = ((fromEnum c)>=65&&(fromEnum c)<=90)||((fromEnum c)>=97&&(fromEnum c)<=122)||((fromEnum c)>=48&&(fromEnum c)<=57)||((fromEnum c)==95)||((fromEnum c)==39)
 -- call after infering types on nested objects
substituteFragments :: String -> [Fragment] -> [(String,[String])] -> String
substituteFragments [] _ _ = ""
substituteFragments str [] _ = str
-- check that all fragments are valid
substituteFragments str fragments svrobjs = substituteFragmentsHelper str fragments 0 "" svrobjs
-- With query code, we use fragments to replace code blocks
-- REQUIRES: the curly braces are correctly balanced and placed
substituteFragmentsHelper :: String -> [Fragment] -> Int -> String -> [(String,[String])] -> String
substituteFragmentsHelper [] _ _ _ _ = ""
substituteFragmentsHelper str [] _ _ _ = str
substituteFragmentsHelper (h:t) fragments l acc svrobjs
    | h=='{'&&l==0 = h:substituteFragmentsHelper t fragments (l+1) [] svrobjs
    | l==0 = h:substituteFragmentsHelper t fragments l [] svrobjs
    | h=='{' = ((h:(subResult))++(substituteFragmentsHelper continue fragments (l+1) [] svrobjs))
    | h=='}' = h:(substituteFragmentsHelper t fragments (l-1) [] svrobjs)
    | otherwise = h:(substituteFragmentsHelper t fragments l (acc++[h]) svrobjs)
  where
    replacer = findFragment fragments (getNestedObject acc svrobjs)
    (subject, continue) = splitSubject t "" 0
    subResult = substituteHelper subject (target replacer) (switch replacer) "" ""
-- from accumulated objects/fields/arguments, we return a found object where code is without brackets
getNestedObject :: String -> [(String,[String])] -> ServerObject
getNestedObject [] _ = E.throw ParseFragmentException
getNestedObject str svrobjs
    | (elem ':' str)&&(elem '(' str) = readServerObject (removeSpaces $ foldl (\y x -> if x==':' then [] else y++[x]) "" (foldr (\x y -> if x=='(' then [] else x:y) "" str)) svrobjs
    | (elem '(' str) = readServerObject (removeSpaces $ foldr (\x y -> if x=='(' then [] else x:y) "" str) svrobjs
    | (elem ':' str) = readServerObject (removeSpaces $ foldl (\y x -> if x==':' then [] else y++[x]) "" str) svrobjs
    | otherwise = readServerObject (removeSpaces str) svrobjs
-- from possible fragments and found fragment (if present), we return (replacement string, target string).
data Replacer = Replacer
    { target :: String
    , switch :: String
    }
findFragment :: [Fragment] -> ServerObject -> Replacer
findFragment [] _ = Replacer { target="",switch="" }  -- we never encounter an empty Fragment list, so we needn't worry about a blank Replacer
findFragment (frt:t) tar
 | (targetObject frt)==tar = Replacer { target=("..."++(name frt)),switch=(replacement frt) }
 | otherwise = findFragment t tar
-- get block in this scope
splitSubject :: String -> String -> Int -> (String,String)
splitSubject [] acc _ = (acc,"")
splitSubject (h:t) acc l
 | l<0 = (acc,h:t)
 | h=='{' = splitSubject t (acc++[h]) (l+1)
 | h=='}' = splitSubject t (acc++[h]) (l-1)
 | otherwise = splitSubject t (acc++[h]) l
-- substitute target string with replacement string within subject string...return result
substituteHelper :: String -> String -> String -> String -> String -> String
substituteHelper [] _ _ acc rlt = (rlt++acc)
substituteHelper subj [] _ _ _ = subj
substituteHelper (h:t) trg rpl acc rlt
 | (length acc)<3&&h=='.' = substituteHelper t trg rpl (acc++[h]) rlt
 | (length acc)<3 = substituteHelper t trg rpl [] (rlt++acc++[h])
 | (isMatching (acc++[h]) trg)&&((length (acc++[h]))==(length trg)) = substituteHelper t trg rpl [] (rlt++rpl)
 | (isMatching (acc++[h]) trg) = substituteHelper t trg rpl (acc++[h]) rlt
 | otherwise = substituteHelper t trg rpl [] (rlt++acc++[h])
-- check whether both strings are thus far same
isMatching :: String -> String -> Bool
isMatching acc trg = foldr (\(x,y) z -> (x==y)&&z) True (zip acc trg)
-- parse provided string to obtain query
{-
REQUIRES: Query is balanced and ordered brackets.
input is whole query string with opening and closing brackets
EFFECTS: Return value is list of desired objects with specifications
passing code block to separateRootObjects() where code block is not including query opening and closing brackets
TODO: change Bool to Either with exceptions
-}
composeObjects :: String -> [(String,[String])] -> RootObjects
composeObjects [] _ = E.throw EmptyQueryException
composeObjects str svrobjs = composeObjectsHelper str 0 svrobjs
composeObjectsHelper :: String -> Int -> [(String,[String])] -> RootObjects
composeObjectsHelper [] _ _ = E.throw EmptyQueryException
composeObjectsHelper (h:t) l svrobjs
 | h=='{'&&l==0 = separateRootObjects (extractLevel t) svrobjs -- find and separate every root object
 | otherwise = composeObjectsHelper t l svrobjs
-- ...separate and determine operation
-- TODO: implement operations
-- determineOperation :: String -> (Operation,String)
-- determineOperation str = determineOperationHelper str ""
-- determineOperationHelper :: String -> String -> String
-- determineOperationHelper [] acc = ((parseOperation acc1),[]) -- TODO: throw exception on empty query
-- determineOperationHelper (h:t) acc
--  | h=='{' = ((parseOperation acc), (removeLevel t))
--  | otherwise = determineOperationHelper t (acc++[h])
-- ...create several RootObjects from query blocks
-- REQUIRES: brackets are balanced and ordered
-- NOTE: only querying is first supported; mutations are later
-- EFFECTS: passing block to createNestedObject where block is including opening and closing curly brackets
separateRootObjects :: String -> [(String,[String])] -> [RootObject]
separateRootObjects str svrobjs = separateRootObjectsHelper str "" svrobjs
separateRootObjectsHelper :: String -> String -> [(String,[String])] -> [RootObject]
separateRootObjectsHelper [] _ _ = []
separateRootObjectsHelper (h:t) acc svrobjs
    | h=='{' = (((createNestedObject (acc++[h]++level) svrobjs) :: RootObject):separateRootObjectsHelper levelTail "" svrobjs)
    | otherwise = separateRootObjectsHelper t (acc++[h]) svrobjs
  where
    (level,levelTail) = splitLevel t "" 0
-- create root object from block
-- EFFECTS: passing code block to parseSubFields where block is not including root object opening and closing curly brackets.
createNestedObject :: String -> [(String,[String])] -> NestedObject
createNestedObject str svrobjs = createNestedObjectHelper str "" svrobjs
createNestedObjectHelper :: String -> String -> [(String,[String])] -> NestedObject
createNestedObjectHelper [] _ _ = E.throw InvalidObjectException  -- we should not encounter this since we already checked against empty brackets
createNestedObjectHelper (h:t) acc svrobjs
 | h=='{' = (NestedObject ((parseAlias acc) :: Alias) ((parseName acc) :: Name) ((parseServerObject acc svrobjs) :: ServerObject) ((parseSubSelection acc) :: SubSelection) ((parseSubFields (extractLevel t) svrobjs) :: SubFields)) :: RootObject
 | otherwise = createNestedObjectHelper t (acc++[h]) svrobjs
-- given object header without any braces, we want a name.
parseServerObject :: String -> [(String,[String])] -> ServerObject
parseServerObject [] svrobjs = readServerObject "" svrobjs
parseServerObject str svrobjs
 | (elem ':' str)==True&&(elem '(' str)==True = readServerObject (removeSpaces $ foldl (\y x -> if x==':' then [] else (y++[x])) "" (foldr (\x y -> if x=='(' then [] else x:y) "" str)) svrobjs
 | (elem ':' str)==True = readServerObject (removeSpaces $ foldl (\y x -> if x==':' then [] else (y++[x])) "" str) svrobjs
 | otherwise = readServerObject (removeSpaces str) svrobjs
-- given object header without any braces, we want the alias if there is one.
parseAlias :: String -> Alias
parseAlias [] = Nothing :: Alias
parseAlias str
    | (elem ':' str)&&(elem '(' str) = parseAlias $ foldr (\x y -> if x=='(' then [] else x:y) "" str
    | (elem ':' str) = Just $ removeSpaces $ foldr (\x y -> if x==':' then [] else x:y) "" str
    | otherwise = Nothing :: Alias
-- parseAlias str = parseAliasHelper str ""
-- parseAliasHelper :: String -> String -> Alias
-- parseAliasHelper [] _ = Nothing :: Alias
-- parseAliasHelper (h:t) acc
--  | h=='(' = Nothing :: Alias
--  | h==':' = (Just $ removeSpaces acc) :: Alias
--  | otherwise = parseAliasHelper t (acc++[h])
parseName :: String -> Name
parseName [] = ""
parseName str
 | (elem ':' str)==True&&(elem '(' str)==True = removeSpaces $ foldl (\y x -> if x==':' then [] else (y++[x])) "" (foldr (\x y -> if x=='(' then [] else x:y) "" str)
 | (elem ':' str)==True = removeSpaces $ foldl (\y x -> if x==':' then [] else (y++[x])) "" str
 | otherwise = removeSpaces str
parseSubSelection :: String -> SubSelection
parseSubSelection [] = Nothing :: SubSelection
parseSubSelection (h:t)
 | h=='('&&(elem ':' t)==True&&(elem ')' t)==True = Just (ScalarType (Nothing :: Alias) ((removeSideSpaces (foldr (\x y -> if x==':' then [] else x:y) "" t)) :: Name) (Nothing :: Transformation) ((Just $ removeSideSpaces $ foldl (\y x -> if x==':' then [] else (y++[x])) "" (foldr (\x y -> if x==')' then [] else x:y) "" t)) :: Argument)) :: SubSelection
 | otherwise = parseSubSelection t
-- REQUIRES: code block on nested object subfields where nested object opening and closing curly brackets are not included
parseSubFields :: String -> [(String,[String])] -> [Field]
parseSubFields [] _ = []
parseSubFields str svrobjs = parseSubFieldsHelper str "" "" svrobjs
parseSubFieldsHelper :: String -> String -> String -> [(String,[String])] -> [Field]
parseSubFieldsHelper [] [] [] _ = []
parseSubFieldsHelper [] [] acc _ = [Left $ createScalarType acc :: Field]
parseSubFieldsHelper [] acc [] _ = [Left $ createScalarType acc :: Field]
parseSubFieldsHelper [] acc1 acc2 _ = (Left $ createScalarType (acc2++acc1)):[]
parseSubFieldsHelper (h:t) acc1 acc2 svrobjs
    | h==':' = parseSubFieldsHelper (removeLeadingSpaces t) (acc2++acc1++[h]) [] svrobjs
    | h==' '&&(length acc1)>0 = parseSubFieldsHelper t [] acc1 svrobjs
    | h==' ' = parseSubFieldsHelper t acc1 acc2 svrobjs
    | h==','&&(length acc1)>0 = (Left $ createScalarType acc1 :: Field):parseSubFieldsHelper t [] [] svrobjs
    | h==','&&(length acc2)>0 = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t [] [] svrobjs
    | h=='('&&(length acc1)>0 = parseSubFieldsHelper selectTail (acc1++[h]++subselect) [] svrobjs
    | h=='('&&(length acc2)>0 = parseSubFieldsHelper selectTail (acc2++[h]++subselect) [] svrobjs
    | h=='{'&&(length acc1)>0 = (Right $ (createNestedObject (acc1++[h]++level) svrobjs) :: Field):parseSubFieldsHelper levelTail [] [] svrobjs
    | h=='{'&&(length acc2)>0 = (Right $ (createNestedObject (acc2++[h]++level) svrobjs) :: Field):parseSubFieldsHelper levelTail [] [] svrobjs
    | h=='}' = parseSubFieldsHelper t acc1 acc2 svrobjs
    | (length acc2)>0 = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t (acc1++[h]) [] svrobjs
    | otherwise = parseSubFieldsHelper t (acc1++[h]) [] svrobjs
  where
    (level,levelTail) = splitLevel t "" 0
    (subselect,selectTail) = getSubSelection t
removeLeadingSpaces :: String -> String
removeLeadingSpaces [] = []
removeLeadingSpaces (h:t) = if h==' ' then removeLeadingSpaces t else (h:t)
-- EFFECTS: return subselection and String remainder
getSubSelection :: String -> (String,String)
getSubSelection str = getSubSelectionHelper str ""
getSubSelectionHelper :: String -> String -> (String,String)
getSubSelectionHelper [] acc = ([],[])
getSubSelectionHelper (h:t) acc 
    | h==')' = (acc++[h], t)
    | otherwise = getSubSelectionHelper t (acc++[h])
-- split level at and without uneven brace.
splitLevel :: String -> String -> Int -> (String,String)
splitLevel [] acc _ = (acc,[])
splitLevel (h:t) acc l
    | l<0 = (acc,(h:t))
    | h=='{' = splitLevel t (acc++[h]) (l+1)
    | h=='}' = splitLevel t (acc++[h]) (l-1)
    | otherwise = splitLevel t (acc++[h]) l
-- pull level and leave out closing brace.
extractLevel :: String -> String
extractLevel [] = []
extractLevel str = extractLevelHelper str 0
extractLevelHelper :: String -> Int -> String
extractLevelHelper [] _ = []
extractLevelHelper (h:t) l
 | h=='{' = h:extractLevelHelper t (l+1)
 | h=='}'&&l==0 = []
 | h=='}' = '}':extractLevelHelper t (l-1)
 | otherwise = h:extractLevelHelper t l
-- -- remove level and leave out closing brace
-- removeLevel :: String -> String
-- removeLevel [] = []
-- removeLevel str = removeLevelHelper str 0
-- removeLevelHelper :: String -> Int -> String
-- removeLevelHelper [] _ = []
-- removeLevelHelper (h:t) l
--  | l<0 = h:t
--  | h=='{' = removeLevelHelper t (l+1)
--  | h=='}' = removeLevelHelper t (l-1)
--  | otherwise = removeLevelHelper t l
removeSpaces :: String -> String
removeSpaces str = [x | x <- str, x/=' ']
createScalarType :: String -> ScalarType
createScalarType [] = E.throw InvalidScalarException
createScalarType str = ScalarType (parseAlias str :: Alias) (parseName str :: Name) (parseTransformation str :: Transformation) (parseArgument str :: Argument)
parseTransformation :: String -> Transformation
parseTransformation [] = Nothing :: Transformation
parseTransformation str
    | (elem '(' str)&&(elem ':' str) = (Just $ removeSideSpaces $ foldr (\x y -> if x==':' then [] else x:y) "" $ foldl (\y x -> if x=='(' then [] else y++[x]) "" str) :: Transformation
    | (elem '(' str) = E.throw SyntaxException
    | otherwise = Nothing :: Transformation
parseArgument :: String -> Argument
parseArgument [] = Nothing :: Argument
parseArgument str
    | (elem ')' str)&&(elem ':' str) = (Just $ removeSideSpaces $ foldr (\x y -> if x==')' then [] else x:y) "" $ foldl (\y x -> if x==':' then [] else y++[x]) "" str) :: Argument
    | (elem ')' str) = E.throw SyntaxException
    | otherwise = Nothing :: Argument
removeSideSpaces :: String -> String
removeSideSpaces str = foldl (\y x -> if (x==' '&&(length y)==0) then [] else y++[x]) "" $ foldr (\x y -> if (x==' '&&(length y)==0) then [] else x:y) "" str
-- parseOperation :: String -> Operation
-- TODO: support mutations


{-----Step 4. CROSS-CHECKING-----}
-- done by ServerObjectValidator.hs

{-----Step 5. MAKE QUERY-----}
-- done by SQLQueryComposer.hs for sql queries

{-----Step 6. PROCESS RESULTS-----}
-- done by PersistentDataProcessor.hs