module Components.Parsers.VariablesParser (parseVariables) where

import Control.Exception (throw)
import Text.JSON (JSValue,JSObject,fromJSObject,Result(Ok,Error),encode,decode)
import Data.List (foldl')
import Model.ServerExceptions (
        VariableException(
          MissingVariableValueException,
          ReadVariablesJsonException,
          VariablesSyntaxException,
          InvalidVariableTypeException
        ),
        QueryException(EmptyQueryException)
    )
import Components.Util (thd3)


-- from a variables string and query string to the query variables, the type, and the value
parseVariables :: String -> String -> [(String,String,String)]
parseVariables :: String -> String -> [(String, String, String)]
parseVariables var :: String
var qry :: String
qry = [(String, String)]
-> [(String, String, Maybe String)] -> [(String, String, String)]
filterToDesired (String -> [(String, String)]
parseVariableValuePairs String
var) (String -> [(String, String, Maybe String)]
getVariableTypePairs String
qry)
-- from variable-values and variable-types to query variable-type-values
filterToDesired :: [(String,String)] -> [(String,String,Maybe String)] -> [(String,String,String)]
filterToDesired :: [(String, String)]
-> [(String, String, Maybe String)] -> [(String, String, String)]
filterToDesired _ [] = []
filterToDesired [] tvar :: [(String, String, Maybe String)]
tvar = if ([(String, String, Maybe String)] -> Bool
anyMaybeMissingValues [(String, String, Maybe String)]
tvar)Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
True then VariableException -> [(String, String, String)]
forall a e. Exception e => e -> a
throw VariableException
MissingVariableValueException else [(String, String, Maybe String)] -> [(String, String, String)]
getDefaultValues [(String, String, Maybe String)]
tvar
filterToDesired vvar :: [(String, String)]
vvar tvars :: [(String, String, Maybe String)]
tvars = ((String, String, Maybe String) -> (String, String, String))
-> [(String, String, Maybe String)] -> [(String, String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (((String, String, Maybe String)
 -> [(String, String)] -> (String, String, String))
-> [(String, String)]
-> (String, String, Maybe String)
-> (String, String, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String, String, Maybe String)
-> [(String, String)] -> (String, String, String)
findVariableValue [(String, String)]
vvar)  [(String, String, Maybe String)]
tvars
findVariableValue :: (String,String,Maybe String) -> [(String,String)] -> (String,String,String)
findVariableValue :: (String, String, Maybe String)
-> [(String, String)] -> (String, String, String)
findVariableValue (vname1 :: String
vname1,vtype :: String
vtype,vval1 :: Maybe String
vval1) ((vname2 :: String
vname2,vval2 :: String
vval2):t :: [(String, String)]
t) = if String
vname1String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
vname2 then (String
vname1,String
vtype,String
vval2) else (String, String, Maybe String)
-> [(String, String)] -> (String, String, String)
findVariableValue (String
vname1,String
vtype,Maybe String
vval1) [(String, String)]
t
findVariableValue (vname :: String
vname,vtype :: String
vtype,Just vval :: String
vval) [] = (String
vname,String
vtype,String
vval :: String)
findVariableValue (vname :: String
vname,vtype :: String
vtype,Nothing) [] =  VariableException -> (String, String, String)
forall a e. Exception e => e -> a
throw VariableException
MissingVariableValueException
anyMaybeMissingValues :: [(String,String,Maybe String)] -> Bool
anyMaybeMissingValues :: [(String, String, Maybe String)] -> Bool
anyMaybeMissingValues vars :: [(String, String, Maybe String)]
vars = ((String, String, Maybe String) -> Bool)
-> [(String, String, Maybe String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
(==) Maybe String
forall a. Maybe a
Nothing (Maybe String -> Bool)
-> ((String, String, Maybe String) -> Maybe String)
-> (String, String, Maybe String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String, Maybe String) -> Maybe String
forall a b c. (a, b, c) -> c
thd3) [(String, String, Maybe String)]
vars
getDefaultValues :: [(String,String,Maybe String)] -> [(String,String,String)]
getDefaultValues :: [(String, String, Maybe String)] -> [(String, String, String)]
getDefaultValues vars :: [(String, String, Maybe String)]
vars = [(String
nam,String
typ,String
val) | (nam :: String
nam,typ :: String
typ,Just val :: String
val)<-[(String, String, Maybe String)]
vars]
-- from given variables argument to variable-values
parseVariableValuePairs :: String -> [(String,String)]
parseVariableValuePairs :: String -> [(String, String)]
parseVariableValuePairs [] = []
parseVariableValuePairs vars :: String
vars = [(String, JSValue)] -> [(String, String)]
castValues ([(String, JSValue)] -> [(String, String)])
-> [(String, JSValue)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ JSObject JSValue -> [(String, JSValue)]
forall e. JSObject e -> [(String, e)]
fromJSObject (JSObject JSValue -> [(String, JSValue)])
-> JSObject JSValue -> [(String, JSValue)]
forall a b. (a -> b) -> a -> b
$ Result (JSObject JSValue) -> JSObject JSValue
checkVariables (String -> Result (JSObject JSValue)
forall a. JSON a => String -> Result a
decode String
vars :: Result (JSObject JSValue))
checkVariables :: Result (JSObject JSValue) -> JSObject JSValue
checkVariables :: Result (JSObject JSValue) -> JSObject JSValue
checkVariables (Ok vars :: JSObject JSValue
vars) = JSObject JSValue
vars
checkVariables (Error _) = VariableException -> JSObject JSValue
forall a e. Exception e => e -> a
throw VariableException
ReadVariablesJsonException
castValues :: [(String,JSValue)] -> [(String,String)]
castValues :: [(String, JSValue)] -> [(String, String)]
castValues vars :: [(String, JSValue)]
vars = [("$"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
removeQuotations String
name),JSValue -> String
forall a. JSON a => a -> String
encode JSValue
val) | (name :: String
name,val :: JSValue
val)<-[(String, JSValue)]
vars]
removeQuotations :: String -> String
removeQuotations :: String -> String
removeQuotations (h1 :: Char
h1:h2 :: Char
h2:t :: String
t) = if Char
h1Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\\'Bool -> Bool -> Bool
&&Char
h2Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='"' then String -> String
removeQuotations String
t else Char
h1Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
removeQuotations (Char
h2Char -> String -> String
forall a. a -> [a] -> [a]
:String
t))
removeQuotations str :: String
str = String
str
getVariableTypePairs :: String -> [(String,String,Maybe String)]
getVariableTypePairs :: String -> [(String, String, Maybe String)]
getVariableTypePairs [] = QueryException -> [(String, String, Maybe String)]
forall a e. Exception e => e -> a
throw QueryException
EmptyQueryException
getVariableTypePairs qry :: String
qry
    | (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem '(' String
epilogue)Bool -> Bool -> Bool
&&(Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ')' String
epilogue) = Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables Bool
False "" Bool
False "" "" (String -> [(String, String, Maybe String)])
-> String -> [(String, String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ String -> String
removeLeadingSpaces (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (String -> Char -> String) -> String -> String -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\y :: String
y x :: Char
x -> if Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='(' then [] else String
yString -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
x]) [] (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> String -> String) -> String -> String -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\x :: Char
x y :: String
y -> if Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==')' then [] else Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
y) [] String
epilogue
    | (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem '(' String
epilogue) = VariableException -> [(String, String, Maybe String)]
forall a e. Exception e => e -> a
throw VariableException
VariablesSyntaxException
    | (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ')' String
epilogue) = VariableException -> [(String, String, Maybe String)]
forall a e. Exception e => e -> a
throw VariableException
VariablesSyntaxException
    | Bool
otherwise = []
  where
    epilogue :: String
epilogue = String -> String
getQueryEpilogue String
qry
getQueryEpilogue :: String -> String
getQueryEpilogue :: String -> String
getQueryEpilogue ('{':t :: String
t) = []
getQueryEpilogue (h :: Char
h:t :: String
t) = Char
hChar -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
getQueryEpilogue String
t)
getQueryEpilogue [] = QueryException -> String
forall a e. Exception e => e -> a
throw QueryException
EmptyQueryException
removeLeadingSpaces :: String -> String
removeLeadingSpaces :: String -> String
removeLeadingSpaces (' ':t :: String
t) = String -> String
removeLeadingSpaces String
t
removeLeadingSpaces (h :: Char
h:t :: String
t) = (Char
hChar -> String -> String
forall a. a -> [a] -> [a]
:String
t)
separateVariables :: Bool -> String -> Bool -> String -> String -> String -> [(String,String,Maybe String)]
separateVariables :: Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables _ [] _ _ _ [] = []  -- no variables
separateVariables _ var :: String
var _ [] _ [] = VariableException -> [(String, String, Maybe String)]
forall a e. Exception e => e -> a
throw VariableException
VariablesSyntaxException  -- variable without type
separateVariables _ var :: String
var _ typ :: String
typ [] [] = if (String -> Bool
isValidBaseType String
typ) then (String
var,String
typ,Maybe String
forall a. Maybe a
Nothing)(String, String, Maybe String)
-> [(String, String, Maybe String)]
-> [(String, String, Maybe String)]
forall a. a -> [a] -> [a]
:[] else VariableException -> [(String, String, Maybe String)]
forall a e. Exception e => e -> a
throw VariableException
InvalidVariableTypeException  -- variable without default value
separateVariables _ var :: String
var _ typ :: String
typ dval :: String
dval [] = if (String -> Bool
isValidBaseType String
typ) then (String
var,String
typ,String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
removeTailSpaces String
dval)(String, String, Maybe String)
-> [(String, String, Maybe String)]
-> [(String, String, Maybe String)]
forall a. a -> [a] -> [a]
:[] else VariableException -> [(String, String, Maybe String)]
forall a e. Exception e => e -> a
throw VariableException
InvalidVariableTypeException  -- variable with default value
separateVariables False acc1 :: String
acc1 typ :: Bool
typ acc2 :: String
acc2 acc3 :: String
acc3 (':':t :: String
t) = Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables Bool
True (String -> String
removeTailSpaces String
acc1) Bool
False [] [] (String -> [(String, String, Maybe String)])
-> String -> [(String, String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ String -> String
removeLeadingSpaces String
t
separateVariables False acc1 :: String
acc1 typ :: Bool
typ acc2 :: String
acc2 acc3 :: String
acc3 (h :: Char
h:t :: String
t) = Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables Bool
False (String
acc1String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
h]) Bool
typ String
acc2 String
acc3 String
t
separateVariables var :: Bool
var acc1 :: String
acc1 False acc2 :: String
acc2 acc3 :: String
acc3 (',':t :: String
t) = if (String -> Bool
isValidBaseType String
finalizedType)Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
True then (String
acc1,String
finalizedType,Maybe String
forall a. Maybe a
Nothing)(String, String, Maybe String)
-> [(String, String, Maybe String)]
-> [(String, String, Maybe String)]
forall a. a -> [a] -> [a]
:Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables Bool
False [] Bool
False [] [] (String -> String
removeLeadingSpaces String
t) else VariableException -> [(String, String, Maybe String)]
forall a e. Exception e => e -> a
throw VariableException
InvalidVariableTypeException
  where
    finalizedType :: String
finalizedType = String -> String
removeTailSpaces String
acc2
separateVariables var :: Bool
var acc1 :: String
acc1 False acc2 :: String
acc2 acc3 :: String
acc3 ('=':t :: String
t)
    | String -> Bool
isValidBaseType String
finalizedType = Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables Bool
var String
acc1 Bool
True String
finalizedType [] (String -> [(String, String, Maybe String)])
-> String -> [(String, String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ String -> String
removeLeadingSpaces String
t
    | Bool
otherwise = VariableException -> [(String, String, Maybe String)]
forall a e. Exception e => e -> a
throw VariableException
InvalidVariableTypeException
  where
    finalizedType :: String
finalizedType = String -> String
removeTailSpaces String
acc2
separateVariables var :: Bool
var acc1 :: String
acc1 False acc2 :: String
acc2 acc3 :: String
acc3 (h :: Char
h:t :: String
t) = Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables Bool
var String
acc1 Bool
False (String
acc2String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
h]) [] String
t
separateVariables var :: Bool
var acc1 :: String
acc1 typ :: Bool
typ acc2 :: String
acc2 acc3 :: String
acc3 (',':t :: String
t) = (String
acc1,String
acc2,if (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
finalizedValue)Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==0 then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
finalizedValue)(String, String, Maybe String)
-> [(String, String, Maybe String)]
-> [(String, String, Maybe String)]
forall a. a -> [a] -> [a]
:(Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables Bool
False [] Bool
False [] [] (String -> [(String, String, Maybe String)])
-> String -> [(String, String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ String -> String
removeLeadingSpaces String
t)
  where
    finalizedValue :: String
finalizedValue = String -> String
removeTailSpaces String
acc3
separateVariables var :: Bool
var acc1 :: String
acc1 typ :: Bool
typ acc2 :: String
acc2 acc3 :: String
acc3 (h :: Char
h:t :: String
t) = Bool
-> String
-> Bool
-> String
-> String
-> String
-> [(String, String, Maybe String)]
separateVariables Bool
var String
acc1 Bool
typ String
acc2 (String
acc3String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
h]) String
t
removeTailSpaces :: String -> String
removeTailSpaces :: String -> String
removeTailSpaces str :: String
str = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
removeLeadingSpaces (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
str
isValidBaseType :: String -> Bool
isValidBaseType :: String -> Bool
isValidBaseType "Text" = Bool
True
isValidBaseType "Int64" = Bool
True
isValidBaseType "Double" = Bool
True
isValidBaseType "Boolean" = Bool
True
isValidBaseType _ = Bool
False