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

import Components.ObjectHandlers.ObjectsHandler (readServerObject)
import Control.Exception (throw)
import Data.Char (toLower)
import Model.ServerExceptions (
    QueryException(
      SyntaxException,
      InvalidScalarException,
      InvalidObjectException,
      InvalidVariableNameException,
      EmptyQueryException,
      ParseFragmentException,
      MismatchedVariableTypeException
    )
  )
import Model.ServerObjectTypes (
    NestedObject(..),
    ServerObject,
    Alias,
    Name,
    Argument,
    Transformation,
    ScalarType(..),
    RootObjects,
    RootObject,
    SubFields,
    InlinefragmentObject(..),
    Field,
    FieldObject,
    SubSelection,
    Fragment(..)
  )


{-----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 ('#':t) _ = removeCommentsHelper t True
removeCommentsHelper ('\r':t) _ = '\r':removeCommentsHelper t False
removeCommentsHelper ('\n':t) _ = '\n':removeCommentsHelper t False
removeCommentsHelper (_:t) True = removeCommentsHelper t True
removeCommentsHelper (h:t) mde = 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 ('\n':t) = ' ':removeLinebreaks t
removeLinebreaks ('\r':t) = ' ':removeLinebreaks t
removeLinebreaks (h:t) = 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 ('{':t) o c = validateBracketLocationQueryHelper t (o+1) c
validateBracketLocationQueryHelper ('}':t) o c
 | o<=c = False
 | otherwise = validateBracketLocationQueryHelper t o (c+1)
validateBracketLocationQueryHelper (_:t) o c = validateBracketLocationQueryHelper t o c
validateNoEmptyBrackets :: String -> Bool
validateNoEmptyBrackets str = validateNoEmptyBracketsHelper str "" []
validateNoEmptyBracketsHelper :: String -> String -> [String] -> Bool
validateNoEmptyBracketsHelper "" acc nst = (length nst)<1
validateNoEmptyBracketsHelper ('{':b) acc [] = validateNoEmptyBracketsHelper b [] [acc]
validateNoEmptyBracketsHelper ('}':b) acc [] = False
validateNoEmptyBracketsHelper (' ':b) acc [] = validateNoEmptyBracketsHelper b acc []
validateNoEmptyBracketsHelper (a:b) acc [] = validateNoEmptyBracketsHelper b (acc++[a]) []
validateNoEmptyBracketsHelper (' ':b) acc (i:j) = validateNoEmptyBracketsHelper b acc (i:j)
validateNoEmptyBracketsHelper ('{':b) acc (i:j)
 | (length acc)==0 = False
 | otherwise = validateNoEmptyBracketsHelper b [] (acc:i:j)
validateNoEmptyBracketsHelper ('}':b) acc (i:j)
 | (length acc)==0 = False
 | otherwise = validateNoEmptyBracketsHelper b i j
validateNoEmptyBracketsHelper (a:b) acc (i:j) = 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 ('{':t) l False q f = getQueryAndFragmentsHelper t (l+1) False (q++"{") f
getQueryAndFragmentsHelper ('}':t) 1 False q f = getQueryAndFragmentsHelper t 0 True (q++"}") f
getQueryAndFragmentsHelper ('}':t) l False q f = getQueryAndFragmentsHelper t (l-1) False (q++"}") f
getQueryAndFragmentsHelper (h:t) l False q f = getQueryAndFragmentsHelper t l False (q++[h]) f
getQueryAndFragmentsHelper (h:t) l m q f = getQueryAndFragmentsHelper t l m q (f++[h])
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 ('{':t) acc l rslt svrobjs soa = parseFragmentsHelper t (acc++"{") (l+1) rslt svrobjs soa
parseFragmentsHelper ('}':t) acc 1 rslt svrobjs soa = parseFragmentsHelper t [] 0 ((createFragment acc svrobjs soa):rslt) svrobjs soa -- completed one fragment
parseFragmentsHelper ('}':t) acc l rslt svrobjs soa = parseFragmentsHelper t (acc++"}") (l-1) rslt svrobjs soa  -- closed a nested object
parseFragmentsHelper (h:t) acc l rslt svrobjs soa = 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 ('f':t) l "" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "f" False n a o rst1 rst2 svrobjs soa
createFragmentHelper ('r':t) l "f" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fr" False n a o rst1 rst2 svrobjs soa
createFragmentHelper ('a':t) l "fr" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fra" False n a o rst1 rst2 svrobjs soa
createFragmentHelper ('g':t) l "fra" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "frag" False n a o rst1 rst2 svrobjs soa
createFragmentHelper ('m':t) l "frag" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fragm" False n a o rst1 rst2 svrobjs soa
createFragmentHelper ('e':t) l "fragm" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fragme" False n a o rst1 rst2 svrobjs soa
createFragmentHelper ('n':t) l "fragme" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fragmen" False n a o rst1 rst2 svrobjs soa
createFragmentHelper ('t':t) l "fragmen" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fragment" False n a o rst1 rst2 svrobjs soa
createFragmentHelper (' ':t) l "fragment" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True n a o rst1 rst2 svrobjs soa
createFragmentHelper (' ':t) l "" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" False n a o rst1 rst2 svrobjs soa
createFragmentHelper _ _ _ False _ _ _ _ _ _ _ = throw ParseFragmentException
createFragmentHelper (' ':t) l "" _ False a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True False a o rst1 rst2 svrobjs soa
createFragmentHelper (' ':t) l acc _ False a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True a o acc rst2 svrobjs soa
createFragmentHelper (h:t) l acc _ False a o rst1 rst2 svrobjs soa
 | (isValidFragmentNameChar h)==False = throw ParseFragmentException
 | otherwise = createFragmentHelper t l (acc++[h]) True False a o rst1 rst2 svrobjs soa
createFragmentHelper (' ':t) l "" _ _ False o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True False o rst1 rst2 svrobjs soa
createFragmentHelper (' ':t) l "on" _ _ False o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True o rst1 rst2 svrobjs soa
createFragmentHelper (' ':_) _ _ _ _ False _ _ _ _ _ = throw ParseFragmentException
createFragmentHelper ('o':t) l acc _ _ False o rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"o") True True False o rst1 rst2 svrobjs soa
createFragmentHelper ('n':t) l acc _ _ False o rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"n") True True False o rst1 rst2 svrobjs soa
createFragmentHelper _ _ _ _ _ False _ _ _ _ _ = throw ParseFragmentException
createFragmentHelper (' ':t) l "" _ _ _ False rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True False rst1 rst2 svrobjs soa
createFragmentHelper (h:t) l "" _ _ _ False rst1 rst2 svrobjs soa
 | (fromEnum h)>=97||(fromEnum h)<=122 = createFragmentHelper t l [h] True True True False rst1 rst2 svrobjs soa
 | otherwise = throw ParseFragmentException
createFragmentHelper (' ':t) l acc _ _ _ False rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True True rst1 acc svrobjs soa
createFragmentHelper ('{':t) l acc _ _ _ False rst1 rst2 svrobjs soa = createFragmentHelper t (l+1) "" True True True True rst1 acc svrobjs soa
createFragmentHelper (h:t) l acc _ _ _ False rst1 rst2 svrobjs soa
 | isValidIdentifierChar h = createFragmentHelper t l (acc++[h]) True True True False rst1 rst2 svrobjs soa
 | otherwise = throw ParseFragmentException
createFragmentHelper (' ':t) 0 acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t 0 "" True True True True rst1 rst2 svrobjs soa
createFragmentHelper ('{':t) 0 acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t 1 "" True True True True rst1 rst2 svrobjs soa
createFragmentHelper _ 0 _ _ _ _ _ _ _ _ _ = throw ParseFragmentException
createFragmentHelper ('{':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t (l+1) (acc++"{") True True True True rst1 rst2 svrobjs soa
createFragmentHelper ('}':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t (l-1) (acc++"}") True True True True rst1 rst2 svrobjs soa
createFragmentHelper (' ':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++" ") True True True True rst1 rst2 svrobjs soa
createFragmentHelper (')':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++")") True True True True rst1 rst2 svrobjs soa
createFragmentHelper ('(':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"(") True True True True rst1 rst2 svrobjs soa
createFragmentHelper (':':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++":") True True True True rst1 rst2 svrobjs soa
createFragmentHelper ('$':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"$") True True True True rst1 rst2 svrobjs soa
createFragmentHelper ('@':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"@") True True True True rst1 rst2 svrobjs soa
createFragmentHelper (h:t) l acc _ _ _ _ rst1 rst2 svrobjs soa
 | isValidIdentifierChar h = createFragmentHelper t l (acc++[h]) True True True True 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)
splitSubject ('{':t) acc l = splitSubject t (acc++"{") (l+1)
splitSubject ('}':t) acc l = splitSubject t (acc++"}") (l-1)
splitSubject (h:t) acc l = 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 ('{':t) 0 svrobjs soa vars fmts = separateRootObjects (extractLevel t) svrobjs soa vars fmts -- find and separate every root object
composeObjectsHelper (_:t) l svrobjs soa vars fmts = 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 ('{':t) acc svrobjs soa vars fmts = (((createNestedObject (acc++"{"++level) svrobjs soa vars fmts) :: RootObject):separateRootObjectsHelper levelTail "" svrobjs soa vars fmts)
  where
    (level,levelTail) = splitLevel t "" 0
separateRootObjectsHelper (h:t) acc svrobjs soa vars fmts = separateRootObjectsHelper t (acc++[h]) svrobjs soa vars fmts
-- 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 ('{':t) acc svrobjs soa vars fmts = NestedObject (parseAlias acc) (parseName acc) serverObj (parseSubSelection acc) ((parseSubFields (extractLevel t) svrobjs soa vars fmts serverObj) :: SubFields) :: RootObject
  where
    serverObj = parseServerObject acc svrobjs soa
createNestedObjectHelper (h:t) acc svrobjs soa vars fmts = createNestedObjectHelper t (acc++[h]) svrobjs soa vars fmts
-- 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 ('(':t)
 | (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
parseSubSelection (h:t) = 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 (':':t) acc1 acc2 svrobjs soa inc vars fmts sobj = parseSubFieldsHelper (removeLeadingSpaces t) (acc2++acc1++":") "" svrobjs soa inc vars fmts sobj
parseSubFieldsHelper (' ':t) acc1 acc2 svrobjs soa inc vars fmts sobj
 | (length acc1)>0 = parseSubFieldsHelper t "" acc1 svrobjs soa inc vars fmts sobj
 | otherwise = parseSubFieldsHelper t acc1 acc2 svrobjs soa inc vars fmts sobj
parseSubFieldsHelper (',':t) acc1 acc2 svrobjs soa True vars fmts sobj
 | (length acc1)>0 = (Left $ createScalarType acc1 :: Field):parseSubFieldsHelper t "" "" svrobjs soa True vars fmts sobj
 | (length acc2)>0 = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t "" "" svrobjs soa True vars fmts sobj  -- if acc is not empty, I assume that acc1 is empty
parseSubFieldsHelper (',':t) acc1 acc2 svrobjs soa inc vars fmts sobj
 | (length acc1)>0 = parseSubFieldsHelper t "" "" svrobjs soa True vars fmts sobj
 | (length acc2)>0 = parseSubFieldsHelper t "" "" svrobjs soa True vars fmts sobj
 | otherwise = parseSubFieldsHelper t acc1 acc2 svrobjs soa inc vars fmts sobj
parseSubFieldsHelper ('(':t) acc1 acc2 svrobjs soa inc vars fmts sobj
    | (length acc1)>0 = parseSubFieldsHelper selectTail (acc1++"("++subselect) "" svrobjs soa inc vars fmts sobj
    | (length acc2)>0 = parseSubFieldsHelper selectTail (acc2++"("++subselect) "" svrobjs soa inc vars fmts sobj
  where
    (subselect,selectTail) = getSubSelection t
parseSubFieldsHelper ('{':t) acc1 acc2 svrobjs soa True vars fmts sobj
    | (length acc1)>0 = (Right (Left (createNestedObject (acc1++"{"++level) svrobjs soa vars fmts) :: FieldObject) :: Field):parseSubFieldsHelper levelTail "" "" svrobjs soa True vars fmts sobj
    | (length acc2)>0 = (Right (Left (createNestedObject (acc2++"{"++level) svrobjs soa vars fmts) :: FieldObject) :: Field):parseSubFieldsHelper levelTail "" "" svrobjs soa True vars fmts sobj
  where
    (level,levelTail) = splitLevel t "" 0
parseSubFieldsHelper ('{':t) acc1 acc2 svrobjs soa _ vars fmts sobj
    | (length acc1)>0 = parseSubFieldsHelper levelTail "" "" svrobjs soa True vars fmts sobj
    | (length acc2)>0 = parseSubFieldsHelper levelTail "" "" svrobjs soa True vars fmts sobj
  where
    (level,levelTail) = splitLevel t "" 0
parseSubFieldsHelper ('@':t) acc1 acc2 svrobjs soa _ vars fmts sobj
    | directive==True = parseSubFieldsHelper directiveTail acc1 acc2 svrobjs soa True vars fmts sobj
    | otherwise = parseSubFieldsHelper directiveTail acc1 acc2 svrobjs soa False vars fmts sobj
  where
    (directive,directiveTail) = checkDirective ('@':t) vars
parseSubFieldsHelper ('.':t) acc1 acc2 svrobjs soa True vars fmts sobj
    | (length acc2)>0 = 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 True vars fmts sobj
  where
    (isInlineFragment,inlinefragmentObj,inlinefragmentBody,inlinefragmentTail) = checkInlinefragment ('.':t)
    (fragmentName,fragmentTail) = findFragment ('.':t)
    fContents = expandFragment fragmentName sobj fmts
parseSubFieldsHelper ('.':t) acc1 acc2 svrobjs soa inc vars fmts sobj
    | (length acc1)>0 = parseSubFieldsHelper t (acc1++".") "" svrobjs soa True vars fmts sobj
    | (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
    | isInlineFragment==True = (Right (Right (createInlinefragmentObject inlinefragmentBody inlinefragmentObj vars fmts svrobjs soa) :: FieldObject) :: Field):parseSubFieldsHelper inlinefragmentTail "" "" svrobjs soa True vars fmts sobj
    | otherwise = parseSubFieldsHelper (fContents++fragmentTail) "" "" svrobjs soa inc vars fmts sobj
  where
    (isInlineFragment,inlinefragmentObj,inlinefragmentBody,inlinefragmentTail) = checkInlinefragment ('.':t)
    (fragmentName,fragmentTail) = findFragment ('.':t)
    fContents = expandFragment fragmentName sobj fmts
parseSubFieldsHelper ('}':t) acc1 acc2 svrobjs soa inc vars fmts sobj = parseSubFieldsHelper t acc1 acc2 svrobjs soa inc vars fmts sobj  -- this character is removed when I pull a level
parseSubFieldsHelper (h:t) acc1 acc2 svrobjs soa True vars fmts sobj
 | (length acc2)>0 = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t (acc1++[h]) "" svrobjs soa True vars fmts sobj
parseSubFieldsHelper (h:t) acc1 acc2 svrobjs soa inc 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


checkInlinefragment :: String -> (Bool,String,String,String)
checkInlinefragment str = checkInlinefragmentHelper str "" False ""
checkInlinefragmentHelper :: String -> String -> Bool -> String -> (Bool,String,String,String)
checkInlinefragmentHelper "" _ _ _ = (False,"","","")
checkInlinefragmentHelper ('.':t) "" sobj obj = checkInlinefragmentHelper t "." False ""
checkInlinefragmentHelper _ "" _ _ = throw ParseFragmentException
checkInlinefragmentHelper ('.':t) "." sobj obj = checkInlinefragmentHelper t ".." False ""
checkInlinefragmentHelper _ "." _ _ = throw ParseFragmentException
checkInlinefragmentHelper ('.':t) ".." sobj obj = checkInlinefragmentHelper t "..." False ""
checkInlinefragmentHelper _ ".." _ _ = throw ParseFragmentException
checkInlinefragmentHelper (' ':t) "..." sobj obj = checkInlinefragmentHelper t "... " False ""
checkInlinefragmentHelper (h:t) "..." sobj obj = (False,"","","..."++(h:t))
checkInlinefragmentHelper (' ':t) "... " sobj obj = checkInlinefragmentHelper t "... " False ""
checkInlinefragmentHelper ('o':t) "... " sobj obj = checkInlinefragmentHelper t "... o" False ""
checkInlinefragmentHelper _ "... " _ _ = throw ParseFragmentException
checkInlinefragmentHelper ('n':t) "... o" sobj obj = checkInlinefragmentHelper t "... n" False ""
checkInlinefragmentHelper _ "... o" _ _ = throw ParseFragmentException
checkInlinefragmentHelper (' ':t) "... on" sobj obj = checkInlinefragmentHelper t "... on " False ""
checkInlinefragmentHelper _ "... on" _ _ = throw ParseFragmentException
checkInlinefragmentHelper (' ':t) "... on " sobj obj = checkInlinefragmentHelper t "... on " False ""
checkInlinefragmentHelper (h:t) "... on " sobj obj
 | ((fromEnum h)>=97||(fromEnum h)<=122) = checkInlinefragmentHelper t ("... on "++[h]) False [h]
 | otherwise = throw ParseFragmentException
checkInlinefragmentHelper (h:t) acc False obj
 | isValidIdentifierChar h = checkInlinefragmentHelper t acc False (obj++[h])
checkInlinefragmentHelper (' ':t) acc False obj = checkInlinefragmentHelper t acc True obj
checkInlinefragmentHelper (' ':t) acc _ obj = checkInlinefragmentHelper t acc True obj
checkInlinefragmentHelper ('{':t) acc _ obj = (True,obj,contents,tail)
  where
    (contents,tail) = splitSubject t "" 0
checkInlinefragmentHelper _ _ _ _ = throw ParseFragmentException

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 ('.':t) "" = findFragmentHelper t "."
findFragmentHelper _ "" = throw ParseFragmentException
findFragmentHelper ('.':t) "." = findFragmentHelper t ".."
findFragmentHelper _ "." = throw ParseFragmentException
findFragmentHelper ('.':t) ".." = findFragmentHelper t "..."
findFragmentHelper _ ".." = throw ParseFragmentException
findFragmentHelper (h:t) "..."
 | isValidFragmentNameChar h = findFragmentHelper t ("..."++[h])
 | otherwise = throw ParseFragmentException
findFragmentHelper (' ':t) acc = (acc,t)
findFragmentHelper (h:t) acc
 | isValidFragmentNameChar h = findFragmentHelper t (acc++[h])
findFragmentHelper _ _ = 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 (' ':t) = removeLeadingSpaces t
removeLeadingSpaces str = str
-- EFFECTS: return subselection and String remainder
getSubSelection :: String -> (String,String)
getSubSelection str = getSubSelectionHelper str ""
getSubSelectionHelper :: String -> String -> (String,String)
getSubSelectionHelper "" acc = ("","")
getSubSelectionHelper (')':t) acc = (acc++")", t)
getSubSelectionHelper (h:t) acc = 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))
splitLevel ('{':t) acc l = splitLevel t (acc++"{") (l+1)
splitLevel ('}':t) acc l = splitLevel t (acc++"}") (l-1)
splitLevel (h:t) acc l = 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 ('@':_) = True
isDirective (' ':t) = isDirective t
isDirective _ = False
getDirective :: String -> (String,String,String)
getDirective (' ':t) = getDirective t
getDirective ('@':t) = (dir,val,tail)
  where
    dir = removeSideSpaces $ foldl (\y x -> if x=='@' then "" else y++[x]) "" $ getPrefix ('@':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,"Bool",val):t) var
 | (name==var) = val
getVariableValue ((name,typ,val):t) var
 | (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 ('{':t) l = '{':extractLevelHelper t (l+1)
extractLevelHelper ('}':t) 0 = ""
extractLevelHelper ('}':t) l = '}':extractLevelHelper t (l-1)
extractLevelHelper (h:t) l = 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) (parseName str) (parseTransformation str) (parseArgument str)
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