module Components.Parsers.QueryParser (processString,validateQuery,parseStringToObjects) where

import Model.ServerExceptions (
        QueryException(
            SyntaxException,
            InvalidScalarException,
            InvalidObjectException,
            InvalidVariableNameException,
            EmptyQueryException,
            ParseFragmentException,
            MismatchedVariableTypeException
        )
    )
import Model.ServerObjectTypes (
        NestedObject(..),
        ServerObject,
        Alias,
        Argument,
        Transformation,
        ScalarType(..),
        RootObjects,
        RootObject,
        Name,
        SubFields,
        InlinefragmentObject(..),
        Field,
        FieldObject,
        SubSelection
    )
import Components.ObjectHandlers.ObjectsHandler (readServerObject)
import Control.Exception (throw)
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 (h:t) mde
 | h=='#' = removeCommentsHelper t True
 | h=='\r' = '\r':removeCommentsHelper t False
 | h=='\n' = '\n':removeCommentsHelper t False
 | mde==True = removeCommentsHelper t mde
 | otherwise = h:(removeCommentsHelper 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:t)
 | h=='\n'   = ' ':removeLinebreaks t
 | h=='\r'   = ' ':removeLinebreaks t
 | otherwise = h:removeLinebreaks 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])] -> [(String,String,String)] -> RootObjects
parseStringToObjects [] _ _ _ = throw EmptyQueryException
parseStringToObjects str svrobjs soa vars = composeObjects qry svrobjs soa vars fragments
  where
    (qry,fmts) = getQueryAndFragments str
    fragments = parseFragments fmts svrobjs soa
    -- 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])] -> [(String,[String],[String])] -> [Fragment]
parseFragments str svrobjs soa = parseFragmentsHelper str "" 0 [] svrobjs soa
parseFragmentsHelper :: String -> String -> Int -> [Fragment] -> [(String,[String])] -> [(String,[String],[String])] -> [Fragment]
parseFragmentsHelper [] _ _ rslt _ _ = rslt
parseFragmentsHelper (h:t) acc l rslt svrobjs soa
 | h=='{' = parseFragmentsHelper t (acc++[h]) (l+1) rslt svrobjs soa
 | h=='}'&&l==1 = parseFragmentsHelper t [] (l-1) ((createFragment acc svrobjs soa):rslt) svrobjs soa -- completed one fragment
 | h=='}' = parseFragmentsHelper t (acc++[h]) (l-1) rslt svrobjs soa  -- closed a nested object
 | otherwise = parseFragmentsHelper t (acc++[h]) l rslt svrobjs soa
-- with a fragment string that is without closing curly braces, we want a fragments
createFragment :: String -> [(String,[String])] -> [(String,[String],[String])] -> Fragment
createFragment str svrobjs soa = createFragmentHelper str 0 [] False False False False "" "" svrobjs soa
{-
    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])] -> [(String,[String],[String])] -> Fragment
createFragmentHelper [] l acc d n a o rst1 rst2 svrobjs soa = if (l==1&&d==True&&n==True&&a==True&&o==True) then Fragment { name=rst1,targetObject=(readServerObject rst2 svrobjs soa),replacement=acc } else throw ParseFragmentException
createFragmentHelper (h:t) l acc d n a o rst1 rst2 svrobjs soa
 | 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 soa
 | d==False&&h==' '&&(length acc)>0&&acc=="fragment" = createFragmentHelper t l [] True n a o rst1 rst2 svrobjs soa
 | d==False&&h==' '&&(length acc)>0 = throw ParseFragmentException
 | d==False&&h==' '&&(length acc)<1 = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs soa
 | d==False = throw ParseFragmentException
 | n==False&&h==' '&&(length acc)==0 = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs soa
 | n==False&&h==' '&&(length acc)>0 = createFragmentHelper t l [] d True a o acc rst2 svrobjs soa
 | n==False&&(isValidFragmentNameChar h)==False = throw ParseFragmentException
 | n==False = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs soa
 | a==False&&h==' '&&(length acc)==0 = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs soa
 | a==False&&h==' '&&(length acc)>0&&(acc=="on") = createFragmentHelper t l [] d n True o rst1 rst2 svrobjs soa
 | a==False&&h==' '&&(length acc)>0 = throw ParseFragmentException
 | a==False&&(h=='o'||h=='n') = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs soa
 | a==False = 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 soa
 | o==False&&((length acc)==0)&&(h==' ') = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs soa
 | o==False&&((length acc)==0) = throw ParseFragmentException
 | o==False&&h==' ' = createFragmentHelper t l [] d n a True rst1 acc svrobjs soa
 | o==False&&h=='{' = createFragmentHelper t (l+1) [] d n a True rst1 acc svrobjs soa
 | o==False&&(isValidIdentifierChar h) = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs soa
 | o==False = throw ParseFragmentException
 | h==' '&&l==0 = createFragmentHelper t l [] d n a o rst1 rst2 svrobjs soa
 | h=='{'&&l==0 = createFragmentHelper t (l+1) [] d n a o rst1 rst2 svrobjs soa
 | l==0 = throw ParseFragmentException
 | (isValidIdentifierChar h)||h==' '||h==')'||h=='('||h==':'||h=='$'||h=='@' = createFragmentHelper t l (acc++[h]) d n a o rst1 rst2 svrobjs soa
 | h=='{' = createFragmentHelper t (l+1) (acc++[h]) d n a o rst1 rst2 svrobjs soa
 | h=='}' = createFragmentHelper t (l-1) (acc++[h]) d n a o rst1 rst2 svrobjs soa
 | otherwise = 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)==36)
--  -- call after infering types on nested objects
-- 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
-- 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])] -> [(String,String,String)] -> [Fragment] -> RootObjects
composeObjects [] _ _ _ _ = throw EmptyQueryException
composeObjects str svrobjs soa vars fmts = composeObjectsHelper str 0 svrobjs soa vars fmts
composeObjectsHelper :: String -> Int -> [(String,[String])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> RootObjects
composeObjectsHelper [] _ _ _ _ _ = throw EmptyQueryException
composeObjectsHelper (h:t) l svrobjs soa vars fmts
 | h=='{'&&l==0 = separateRootObjects (extractLevel t) svrobjs soa vars fmts -- find and separate every root object
 | otherwise = composeObjectsHelper t l svrobjs soa vars fmts
-- ...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])] -> [(String,String,String)] -> [Fragment] -> [RootObject]
separateRootObjects str svrobjs soa vars fmts = separateRootObjectsHelper str "" svrobjs soa vars fmts
separateRootObjectsHelper :: String -> String -> [(String,[String])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> [RootObject]
separateRootObjectsHelper [] _ _ _ _ _ = []
separateRootObjectsHelper (h:t) acc svrobjs soa vars fmts
    | h=='{' = (((createNestedObject (acc++[h]++level) svrobjs soa vars fmts) :: RootObject):separateRootObjectsHelper levelTail "" svrobjs soa vars fmts)
    | otherwise = separateRootObjectsHelper t (acc++[h]) svrobjs soa vars fmts
  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])] -> [(String,String,String)] -> [Fragment] -> NestedObject
createNestedObject str svrobjs soa vars fmts = createNestedObjectHelper str "" svrobjs soa vars fmts
createNestedObjectHelper :: String -> String -> [(String,[String])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> NestedObject
createNestedObjectHelper [] _ _ _ _ _ = throw InvalidObjectException  -- we should not encounter this since we already checked against empty brackets
createNestedObjectHelper (h:t) acc svrobjs soa vars fmts
    | h=='{' = (NestedObject ((parseAlias acc) :: Alias) ((parseName acc) :: Name) serverObj ((parseSubSelection acc) :: SubSelection) ((parseSubFields (extractLevel t) svrobjs soa vars fmts serverObj) :: SubFields)) :: RootObject
    | otherwise = createNestedObjectHelper t (acc++[h]) svrobjs soa vars fmts
  where
    serverObj = ((parseServerObject acc svrobjs soa) :: ServerObject)
-- given object header without any braces, we want a name.
parseServerObject :: String -> [(String,[String])] -> [(String,[String],[String])] -> ServerObject
parseServerObject [] svrobjs soa = readServerObject "" svrobjs soa
parseServerObject str svrobjs soa
 | (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 soa
 | (elem ':' str)==True = readServerObject (removeSpaces $ foldl (\y x -> if x==':' then [] else (y++[x])) "" str) svrobjs soa
 | otherwise = readServerObject (removeSpaces str) svrobjs soa
-- 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
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])] -> [(String,String,String)] -> [Fragment] -> ServerObject -> [Field]
parseSubFields [] _ _ _ _ _ = []
parseSubFields str svrobjs soa vars fmts sobj = parseSubFieldsHelper str [] [] svrobjs soa True vars fmts sobj
parseSubFieldsHelper :: String -> String -> String -> [(String,[String])] -> [(String,[String],[String])] -> Bool -> [(String,String,String)] -> [Fragment] -> ServerObject -> [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 soa inc vars fmts sobj
    | h==':' = parseSubFieldsHelper (removeLeadingSpaces t) (acc2++acc1++[h]) [] svrobjs soa inc vars fmts sobj
    | h==' '&&(length acc1)>0 = parseSubFieldsHelper t [] acc1 svrobjs soa inc vars fmts sobj
    | h==' ' = parseSubFieldsHelper t acc1 acc2 svrobjs soa inc vars fmts sobj
    | h==','&&(length acc1)>0&&(inc==True) = (Left $ createScalarType acc1 :: Field):parseSubFieldsHelper t [] [] svrobjs soa True vars fmts sobj
    | h==','&&(length acc1)>0 = parseSubFieldsHelper t [] [] svrobjs soa True vars fmts sobj
    | h==','&&(length acc2)>0&&(inc==True) = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t [] [] svrobjs soa True vars fmts sobj
    | h==','&&(length acc2)>0 = parseSubFieldsHelper t [] [] svrobjs soa True vars fmts sobj
    | h==',' = parseSubFieldsHelper t acc1 acc2 svrobjs soa inc vars fmts sobj
    | h=='('&&(length acc1)>0 = parseSubFieldsHelper selectTail (acc1++[h]++subselect) [] svrobjs soa inc vars fmts sobj
    | h=='('&&(length acc2)>0 = parseSubFieldsHelper selectTail (acc2++[h]++subselect) [] svrobjs soa inc vars fmts sobj
    | h=='{'&&(length acc1)>0&&(inc==True) = (Right $ (Left $ (createNestedObject (acc1++[h]++level) svrobjs soa vars fmts) :: FieldObject) :: Field):parseSubFieldsHelper levelTail [] [] svrobjs soa True vars fmts sobj
    | h=='{'&&(length acc1)>0 = parseSubFieldsHelper levelTail [] [] svrobjs soa True vars fmts sobj
    | h=='{'&&(length acc2)>0&&(inc==True) = (Right $ (Left $ (createNestedObject (acc2++[h]++level) svrobjs soa vars fmts) :: FieldObject) :: Field):parseSubFieldsHelper levelTail [] [] svrobjs soa True vars fmts sobj
    | h=='{'&&(length acc2)>0 = parseSubFieldsHelper levelTail [] [] svrobjs soa True vars fmts sobj
    | h=='@'&&directive==True = parseSubFieldsHelper directiveTail acc1 acc2 svrobjs soa True vars fmts sobj
    | h=='@' = parseSubFieldsHelper directiveTail acc1 acc2 svrobjs soa False vars fmts sobj
    | h=='.'&&(length acc1)>0 = parseSubFieldsHelper t (acc1++[h]) [] svrobjs soa True vars fmts sobj
    | h=='.'&&(length acc2)>0&&inc==True = if isInlineFragment then (Left $ createScalarType acc2 :: Field):(Right (Right $ (createInlinefragmentObject inlinefragmentBody inlinefragmentObj vars fmts svrobjs soa) :: FieldObject) :: Field):parseSubFieldsHelper inlinefragmentTail [] [] svrobjs soa True vars fmts sobj else parseSubFieldsHelper (fContents++fragmentTail) [] [] svrobjs soa inc vars fmts sobj
    | h=='.'&&(length acc2)>0 = if isInlineFragment then (Right (Right $ (createInlinefragmentObject inlinefragmentBody inlinefragmentObj vars fmts svrobjs soa) :: FieldObject) :: Field):parseSubFieldsHelper inlinefragmentTail [] [] svrobjs soa True vars fmts sobj else parseSubFieldsHelper (fContents++fragmentTail) [] [] svrobjs soa inc vars fmts sobj
    | h=='.'&&isInlineFragment==True = (Right (Right $ (createInlinefragmentObject inlinefragmentBody inlinefragmentObj vars fmts svrobjs soa) :: FieldObject) :: Field):parseSubFieldsHelper inlinefragmentTail [] [] svrobjs soa True vars fmts sobj
    | h=='.' = parseSubFieldsHelper (fContents++fragmentTail) [] [] svrobjs soa inc vars fmts sobj
    | h=='}' = parseSubFieldsHelper t acc1 acc2 svrobjs soa inc vars fmts sobj  -- this character is removed when I pull a level
    | (length acc2)>0&&inc==True = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t (acc1++[h]) [] svrobjs soa True vars fmts sobj
    | (length acc2)>0 = parseSubFieldsHelper t (acc1++[h]) [] svrobjs soa True vars fmts sobj
    | otherwise = parseSubFieldsHelper t (acc1++[h]) [] svrobjs soa inc vars fmts sobj
  where
    (level,levelTail) = splitLevel t "" 0
    (subselect,selectTail) = getSubSelection t
    (directive,directiveTail) = checkDirective (h:t) vars
    (isInlineFragment,inlinefragmentObj,inlinefragmentBody,inlinefragmentTail) = checkInlinefragment (h:t)
    (fragmentName,fragmentTail) = findFragment (h:t)
    fContents = expandFragment fragmentName sobj fmts

checkInlinefragment :: String -> (Bool,String,String,String)
checkInlinefragment str = checkInlinefragmentHelper str [] False []
checkInlinefragmentHelper :: String -> String -> Bool -> String -> (Bool,String,String,String)
checkInlinefragmentHelper [] _ _ _ = (False,[],[],[])
checkInlinefragmentHelper (h:t) acc sobj obj
    | (length acc)<3&&h=='.' = checkInlinefragmentHelper t (acc++[h]) False []
    | (length acc)<3 = throw ParseFragmentException
    | (length acc)==3&&h/=' ' = (False,[],[],(acc++(h:t)))
    | (length acc)==3 = checkInlinefragmentHelper t (acc++[h]) False []
    | (length acc)==4&&h==' ' = checkInlinefragmentHelper t acc False []
    | (length acc)==4&&h=='o' = checkInlinefragmentHelper t (acc++[h]) False []
    | (length acc)==4 = throw ParseFragmentException
    | (length acc)==5&&h=='n' = checkInlinefragmentHelper t (acc++[h]) False []
    | (length acc)==5 = throw ParseFragmentException
    | (length acc)==6&&h==' ' = checkInlinefragmentHelper t (acc++[h]) False []
    | (length acc)==6 = throw ParseFragmentException
    | (length acc)==7&&h==' ' = checkInlinefragmentHelper t acc False []
    | (length acc)==7&&((fromEnum h)>=97||(fromEnum h)<=122) = checkInlinefragmentHelper t (acc++[h]) False [h]
    | (length acc)==7 = throw ParseFragmentException
    | (length acc)>7&&sobj==False&&(isValidIdentifierChar h) = checkInlinefragmentHelper t acc False (obj++[h])
    | (length acc)>7&&sobj==False&&h==' ' = checkInlinefragmentHelper t acc True obj
    | (length acc)>7&&h==' ' = checkInlinefragmentHelper t acc True obj
    | (length acc)>7&&h/='{' = throw ParseFragmentException
    | (length acc)>7 = (True,obj,contents,tail)
    | otherwise = throw ParseFragmentException
  where
    (contents,tail) = splitSubject t [] 0 
createInlinefragmentObject :: String -> String -> [(String,String,String)] -> [Fragment] -> [(String,[String])] -> [(String,[String],[String])] -> InlinefragmentObject
createInlinefragmentObject bdy obj vars fmts svrobjs soa = (InlinefragmentObject (readServerObject obj svrobjs soa) ((parseSubFields bdy svrobjs soa vars fmts obj) :: SubFields))

findFragment :: String -> (String,String)
findFragment [] = throw ParseFragmentException
findFragment str = findFragmentHelper str []
findFragmentHelper :: String -> String -> (String,String)
findFragmentHelper [] acc = (acc,[])
findFragmentHelper (h:t) acc
  | (length acc)<3&&h=='.' = findFragmentHelper t (acc++[h])
  | (length acc)<3 = throw ParseFragmentException
  | (length acc)==3&&(isValidFragmentNameChar h) = findFragmentHelper t (acc++[h])
  | (length acc)==3 = throw ParseFragmentException
  | (length acc)>3&&(isValidFragmentNameChar h) = findFragmentHelper t (acc++[h])
  | (length acc)>3&&h==' ' = (acc,t)
  | otherwise = throw ParseFragmentException
    
expandFragment :: String -> ServerObject -> [Fragment] -> String
expandFragment _ _ [] = throw ParseFragmentException
expandFragment fnm sobj (h:t) = if (targetObject h)==sobj&&fnm==("..."++(name h)) then (replacement h) else expandFragment fnm sobj 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
-- 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 = 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 (h:t) chr = if (h==chr) then [] else h:getPrefix t chr
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 [] _ = throw InvalidVariableNameException
getVariableValue ((name,typ,val):t) var
    | (name==var)&&(typ=="Bool") = val
    | (name==var) = 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 [] = 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) = 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) = 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