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)
import Data.Char (toLower)


{-----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])] -> [(String,String,String)] -> RootObjects
parseStringToObjects [] _ _ = E.throw EmptyQueryException
parseStringToObjects str svrobjs vars = composeObjects query svrobjs vars
  where
    (qry,fmts) = getQueryAndFragments str
    fragments = parseFragments fmts svrobjs
    query = substituteFragments qry fragments svrobjs vars
-- 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
-}
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==' '||h==')'||h=='('||h==':'||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,String,String)] -> String
substituteFragments [] _ _ _ = ""
substituteFragments str [] _ _ = str
-- check that all fragments are valid
substituteFragments str fragments svrobjs vars = substituteFragmentsHelper str fragments 0 "" svrobjs vars
-- 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,String,String)] -> String
substituteFragmentsHelper [] _ _ _ _ _ = ""
substituteFragmentsHelper str [] _ _ _ _ = str
substituteFragmentsHelper (h:t) fragments l acc svrobjs vars
    | h=='{'&&l==0 = h:substituteFragmentsHelper t fragments (l+1) [] svrobjs vars
    | l==0 = h:substituteFragmentsHelper t fragments l [] svrobjs vars
    | h=='{' = ((h:(subResult))++(substituteFragmentsHelper continue fragments (l+1) [] svrobjs vars))
    | h=='}' = h:(substituteFragmentsHelper t fragments (l-1) [] svrobjs vars)
    | otherwise = h:(substituteFragmentsHelper t fragments l (acc++[h]) svrobjs vars)
  where
    replacer = findFragment fragments (getNestedObject acc svrobjs)
    (subject, continue) = splitSubject t "" 0
    subResult = substituteHelper subject (target replacer) (switch replacer) "" "" vars
-- 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,String,String)] -> String
substituteHelper [] _ _ acc rlt _ = (rlt++acc)
substituteHelper subj [] _ _ _ _ = subj
substituteHelper (h:t) trg rpl acc rlt vars
    | (length acc)<3&&h=='.' = substituteHelper t trg rpl (acc++[h]) rlt vars
    | (length acc)<3 = substituteHelper t trg rpl [] (rlt++acc++[h]) vars
    | (isMatching (acc++[h]) trg)&&((length (acc++[h]))==(length trg))&&(directive==True) = substituteHelper t trg rpl [] (rlt++rpl) vars
    | (isMatching (acc++[h]) trg)&&((length (acc++[h]))==(length trg)) = substituteHelper directiveTail trg rpl [] rlt vars
    | (isMatching (acc++[h]) trg) = substituteHelper t trg rpl (acc++[h]) rlt vars
    | otherwise = substituteHelper t trg rpl [] (rlt++acc++[h]) vars
  where
    (directive,directiveTail) = checkDirective t vars
-- 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])] -> [(String,String,String)] -> RootObjects
composeObjects [] _ _ = E.throw EmptyQueryException
composeObjects str svrobjs vars = composeObjectsHelper str 0 svrobjs vars
composeObjectsHelper :: String -> Int -> [(String,[String])] -> [(String,String,String)] -> RootObjects
composeObjectsHelper [] _ _ _ = E.throw EmptyQueryException
composeObjectsHelper (h:t) l svrobjs vars
 | h=='{'&&l==0 = separateRootObjects (extractLevel t) svrobjs vars -- find and separate every root object
 | otherwise = composeObjectsHelper t l svrobjs vars
-- ...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])] -> [(String,String,String)] -> [RootObject]
separateRootObjects str svrobjs vars = separateRootObjectsHelper str "" svrobjs vars
separateRootObjectsHelper :: String -> String -> [(String,[String])] -> [(String,String,String)] -> [RootObject]
separateRootObjectsHelper [] _ _ _ = []
separateRootObjectsHelper (h:t) acc svrobjs vars
    | h=='{' = (((createNestedObject (acc++[h]++level) svrobjs vars) :: RootObject):separateRootObjectsHelper levelTail "" svrobjs vars)
    | otherwise = separateRootObjectsHelper t (acc++[h]) svrobjs vars
  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])] -> [(String,String,String)] -> NestedObject
createNestedObject str svrobjs vars = createNestedObjectHelper str "" svrobjs vars
createNestedObjectHelper :: String -> String -> [(String,[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 vars
 | h=='{' = (NestedObject ((parseAlias acc) :: Alias) ((parseName acc) :: Name) ((parseServerObject acc svrobjs) :: ServerObject) ((parseSubSelection acc) :: SubSelection) ((parseSubFields (extractLevel t) svrobjs vars) :: SubFields)) :: RootObject
 | otherwise = createNestedObjectHelper t (acc++[h]) svrobjs vars
-- 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])] -> [(String,String,String)] -> [Field]
parseSubFields [] _ _ = []
parseSubFields str svrobjs vars = parseSubFieldsHelper str "" "" svrobjs True vars
parseSubFieldsHelper :: String -> String -> String -> [(String,[String])] -> Bool -> [(String,String,String)] -> [Field]
parseSubFieldsHelper [] [] [] _ _ _ = []
parseSubFieldsHelper [] [] acc _ True _ = [Left $ createScalarType acc :: Field]
parseSubFieldsHelper [] [] acc _ False _ = []
parseSubFieldsHelper [] acc [] _ True _ = [Left $ createScalarType acc :: Field]
parseSubFieldsHelper [] acc [] _ False _ = []
-- There is not a case where both acc1 and acc2 are not empty, but I'll catch anyway
parseSubFieldsHelper [] acc1 acc2 _ True _ = (Left $ createScalarType (acc2++acc1)):[]
parseSubFieldsHelper [] acc1 acc2 _ False _ = []
parseSubFieldsHelper (h:t) acc1 acc2 svrobjs inc vars
    | h==':' = parseSubFieldsHelper (removeLeadingSpaces t) (acc2++acc1++[h]) [] svrobjs inc vars
    | h==' '&&(length acc1)>0 = parseSubFieldsHelper t [] acc1 svrobjs inc vars
    | h==' ' = parseSubFieldsHelper t acc1 acc2 svrobjs inc vars
    | h==','&&(length acc1)>0&&(inc==True) = (Left $ createScalarType acc1 :: Field):parseSubFieldsHelper t [] [] svrobjs True vars
    | h==','&&(length acc1)>0 = parseSubFieldsHelper t [] [] svrobjs True vars
    | h==','&&(length acc2)>0&&(inc==True) = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t [] [] svrobjs True vars
    | h==','&&(length acc2)>0 = parseSubFieldsHelper t [] [] svrobjs True vars
    | h=='('&&(length acc1)>0 = parseSubFieldsHelper selectTail (acc1++[h]++subselect) [] svrobjs inc vars
    | h=='('&&(length acc2)>0 = parseSubFieldsHelper selectTail (acc2++[h]++subselect) [] svrobjs inc vars
    | h=='{'&&(length acc1)>0&&(inc==True) = (Right $ (createNestedObject (acc1++[h]++level) svrobjs vars) :: Field):parseSubFieldsHelper levelTail [] [] svrobjs True vars
    | h=='{'&&(length acc1)>0 = parseSubFieldsHelper levelTail [] [] svrobjs True vars
    | h=='{'&&(length acc2)>0&&(inc==True) = (Right $ (createNestedObject (acc2++[h]++level) svrobjs vars) :: Field):parseSubFieldsHelper levelTail [] [] svrobjs True vars
    | h=='{'&&(length acc2)>0 = parseSubFieldsHelper levelTail [] [] svrobjs True vars
    | h=='@'&&(directive==True) = parseSubFieldsHelper directiveTail acc1 acc2 svrobjs True vars
    | h=='@' = parseSubFieldsHelper directiveTail acc1 acc2 svrobjs False vars
    | h=='}' = parseSubFieldsHelper t acc1 acc2 svrobjs inc vars
    | (length acc2)>0&&inc==True = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t (acc1++[h]) [] svrobjs True vars
    | (length acc2)>0 = parseSubFieldsHelper t (acc1++[h]) [] svrobjs True vars
    | otherwise = parseSubFieldsHelper t (acc1++[h]) [] svrobjs inc vars
  where
    (level,levelTail) = splitLevel t "" 0
    (subselect,selectTail) = getSubSelection t
    (directive,directiveTail) = checkDirective (h:t) vars
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
-- determine if directive result is to include or exclude
checkDirective :: String -> [(String,String,String)] -> (Bool, String)
checkDirective qry vars = if (isDirective qry)==False then (True,qry) else checkDirectiveHelper (getDirective qry) vars
checkDirectiveHelper :: (String,String,String) -> [(String,String,String)] -> (Bool,String)
checkDirectiveHelper (dir,(h:t),tail) vars
    | directive=="include"&&value=="true"=(True,tail)
    | directive=="include"&&value=="false"=(False,tail)
    | directive=="skip"&&value=="true"=(False,tail)
    | directive=="skip"&&value=="false"=(True,tail)
    | otherwise = E.throw InvalidScalarException
  where
    directive = toLowercase dir
    value = if h=='$' then toLowercase $ getVariableValue vars (h:t) else toLowercase (h:t)
isDirective :: String -> Bool
isDirective [] = False
isDirective (h:t)
    | h=='@' = True
    | h==' ' = isDirective t
    | otherwise = False
getDirective :: String -> (String,String,String)
getDirective (h:t)
    | h==' ' = getDirective t
    | h=='@' = (dir,val,tail)
  where
    dir = removeSideSpaces $ foldl (\y x -> if x=='@' then [] else y++[x]) "" $ getPrefix (h:t) '('
    val = removeSideSpaces $ foldl (\y x -> if x==':' then [] else y++[x]) "" $ getPrefix t ')'
    tail = getSuffix t ')'
getPrefix :: String -> Char -> String
getPrefix [] _ = []
getPrefix str chr = getPrefixHelper str chr ""
getPrefixHelper :: String -> Char -> String -> String
getPrefixHelper [] _ _ = ""
getPrefixHelper (h:t) trg acc = if h==trg then acc else getPrefixHelper t trg (acc++[h])
getSuffix :: String -> Char -> String
getSuffix [] _ = []
getSuffix (h:t) chr = if h==chr then t else getSuffix t chr
toLowercase :: String -> String
toLowercase str = [toLower c | c <- str]
getVariableValue :: [(String,String,String)] -> String -> String
getVariableValue [] _ = E.throw InvalidVariableNameException
getVariableValue ((name,typ,val):t) var
    | (name==var)&&(typ=="Bool") = val
    | (name==var) = E.throw MismatchedVariableTypeException
    | otherwise = getVariableValue t var
-- 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