graphql-w-persistent 0.2.0.1 → 0.3.0.0

raw patch · 7 files changed

+85/−32 lines, 7 files

Files

• ChangeLog.md +7/−3
• graphql-w-persistent.cabal +1/−1
• src/Components/DataProcessors/PersistentDataProcessor.hs +40/−18
• src/Components/ObjectHandlers/ServerObjectValidator.hs +1/−1
• src/Components/QueryComposers/SQLQueryComposer.hs +7/−4
• src/GraphQL.hs +27/−4
• src/Model/ServerExceptions.hs +2/−1

@@ -30,12 +30,16 @@ 
 ## 0.1.0.7 -- 2018-10-26
 
-* json file schema
+* json file schema - stable
 
 ## 0.2.0.0 -- 2018-11-05
 
-* variables are available
+* variables are available...api change is schema changes
 
 ## 0.2.0.1 -- 2018-11-05
 
-* fix to accept empty variable arguments and default values+* fix to accept empty variable arguments and default values
+
+## 0.3.0.0 -- 2018-11-06
+
+* bug-fix to reenable relationship queries and casting returned values with Int, Rationals/Decimals, and Doubles...api change is arguments change to processing data function

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.2.0.1
+version:             0.3.0.0
 
 -- A short (one-line) description of the package.
 synopsis:            Haskell GraphQL query parser-interpreter-data processor.

@@ -2,8 +2,8 @@ 
 import Data.Maybe
 import Data.Either
-import Data.Text (Text)
-import Text.JSON (encodeStrict,toJSObject,JSValue,showJSONs,toJSObject,showJSON)
+import Data.Text (Text,unpack)
+import Text.JSON
 import qualified Control.Exception as E
 import Model.ServerExceptions
 import Model.ServerObjectTypes
@@ -11,31 +11,36 @@ 
 
 -- with root objects we want one json representation of separate graphql results...
-processReturnedValues :: [RootObject] -> [[[[Text]]]] -> String
-processReturnedValues robjs rlts = encodeStrict $ toJSObject [("data", toJSObject [processReturnedValue x y | (x,y) <- zip robjs rlts])]
+processReturnedValues :: [(String,[(String,String)])] -> [RootObject] -> [[[[Text]]]] -> String
+processReturnedValues sss robjs rlts = encodeStrict $ processReturnedValuesToJsonObject sss robjs rlts
+processReturnedValuesToJsonObject :: [(String,[(String,String)])] -> [RootObject] -> [[[[Text]]]] -> JSObject (JSObject JSValue)
+processReturnedValuesToJsonObject sss robjs rlts = toJSObject [("data", toJSObject [processReturnedValue sss x y | (x,y) <- zip robjs rlts])]
 -- with qraphql query object and sql return data, we want json representation on graphql query results...
-processReturnedValue :: RootObject -> [[[Text]]] -> (String, JSValue)
-processReturnedValue (NestedObject alias name _ _ sfs) rlts = (if (alias==Nothing) then name else (fromJust alias), showJSONs $ processSubFields sfs rlts)
+processReturnedValue :: [(String,[(String,String)])] -> RootObject -> [[[Text]]] -> (String, JSValue)
+processReturnedValue sss (NestedObject alias name sobj _ sfs) rlts = (if (alias==Nothing) then name else (fromJust alias), showJSONs $ processSubFields sss sobj sfs rlts)
 -- with SubFields and data rows, we want json representation on qraphql query data
-processSubFields :: [Field] -> [[[Text]]] -> [JSValue]
-processSubFields _ [] = []
-processSubFields sfs rlts = foldr (\x y -> x++y) [] [((showJSON $ toJSObject $ composeGraphQlRow sfs $ fetchGraphQlRow typ):(processSubFields sfs [removeDataRow typ])) |typ<-rlts,(length typ)>0]
-composeGraphQlRow :: [Field] -> [[Text]] -> [(String,JSValue)]
-composeGraphQlRow [] ([]:t) = [] -- done
--- composeGraphQlRow _ [] = [] -- no data
-composeGraphQlRow _ ([]:t) = E.throw EOFDataProcessingException
-composeGraphQlRow [] _ = E.throw EOFDataProcessingException
-composeGraphQlRow (a:b) ((h:t):j)
-    | (isLeft a)==True = (((getScalarFieldLabel $ fromLeft (E.throw InvalidScalarException) a), (showJSON h)):(composeGraphQlRow b (removeNDataColumns 1 ((h:t):j))))
-    | otherwise = (((getNestedObjectFieldLabel $ fromRight (E.throw InvalidObjectException) a), showJSONs (processSubFields (getSubFields $ fromRight (E.throw InvalidObjectException) a) [pullNDataColumns nestedObjectFieldCount ((h:t):j)])):(composeGraphQlRow b (removeNDataColumns nestedObjectFieldCount ((h:t):j))))
+processSubFields :: [(String,[(String,String)])] -> String -> [Field] -> [[[Text]]] -> [JSValue]
+processSubFields _ _ _ [] = []
+processSubFields sss sobj sfs rlts = foldr (\x y -> x++y) [] [((showJSON $ toJSObject $ composeGraphQlRow sss sobj sfs $ fetchGraphQlRow typ):(processSubFields sss sobj sfs [removeDataRow typ])) |typ<-rlts,(length typ)>0]
+composeGraphQlRow :: [(String,[(String,String)])] -> String -> [Field] -> [[Text]] -> [(String,JSValue)]
+composeGraphQlRow _ _ [] ([]:t) = [] -- done
+-- composeGraphQlRow _ _ _ [] = [] -- no data
+composeGraphQlRow _ _ _ ([]:t) = E.throw EOFDataProcessingException
+composeGraphQlRow _ _ [] _ = E.throw EOFDataProcessingException
+composeGraphQlRow sss sobj (a:b) ((h:t):j)
+    | (isLeft a)==True = ((getScalarFieldLabel scalarField, castJSType (getScalarFields sobj sss) (getScalarFieldName scalarField) h):(composeGraphQlRow sss sobj b (removeNDataColumns 1 ((h:t):j))))
+    | otherwise = (((getNestedObjectFieldLabel $ fromRight (E.throw InvalidObjectException) a), showJSONs (processSubFields sss sobj (getSubFields $ fromRight (E.throw InvalidObjectException) a) [pullNDataColumns nestedObjectFieldCount ((h:t):j)])):(composeGraphQlRow sss sobj b (removeNDataColumns nestedObjectFieldCount ((h:t):j))))
   where
     nestedObjectFieldCount = (countNestedObjectQueriedFields $ fromRight (E.throw InvalidObjectException) a)
+    scalarField = (fromLeft (E.throw InvalidScalarException) a)
 fetchGraphQlRow :: [[Text]] -> [[Text]]
 fetchGraphQlRow rlts = [t | (h:t)<-rlts, (h)==(head $ head rlts)]
 removeDataRow :: [[Text]] -> [[Text]]
 removeDataRow rlts = [x | x<-rlts, (head x)/=(head $ head rlts)]
 getScalarFieldLabel :: ScalarType -> String
 getScalarFieldLabel (ScalarType alias name trans arg) = if (alias/=Nothing) then (fromJust alias) else name
+getScalarFieldName :: ScalarType -> String
+getScalarFieldName (ScalarType alias name trans arg) = name
 getNestedObjectFieldLabel :: NestedObject -> String
 getNestedObjectFieldLabel (NestedObject alias name sobj ss sfs) = if (alias/=Nothing) then (fromJust alias) else name
 pullNDataColumns :: Int -> [[Text]] -> [[Text]]
@@ -57,4 +62,21 @@ removeNDataColumns (-1) _ = E.throw EOFDataProcessingException
 removeNDataColumns _ [[]] = [[]]
 removeNDataColumns _ ([]:t) = E.throw EOFDataProcessingException
-removeNDataColumns cnt rslt = removeNDataColumns (cnt-1) [t | (h:t)<-rslt]+removeNDataColumns cnt rslt = removeNDataColumns (cnt-1) [t | (h:t)<-rslt]
+getScalarFields :: String -> [(String,[(String,String)])] -> [(String,String)]
+getScalarFields sobj [] = E.throw InvalidObjectException
+getScalarFields sobj ((nam,oflds):t) = if (sobj==nam) then oflds else (getScalarFields sobj t)
+castJSType :: [(String,String)] -> String -> Text -> JSValue
+castJSType [] fld val = E.throw InvalidObjectScalarFieldException
+castJSType ((nam,typ):t) fld val
+    | (nam==fld)&&(typ=="Text") = showJSON val
+    | (nam==fld)&&(typ=="ByteString") = showJSON val
+    | (nam==fld)&&(typ=="Int") = showJSON (Prelude.read $ unpack val :: Int)
+    | (nam==fld)&&(typ=="Double") = showJSON (Prelude.read $ unpack val :: Double)
+    | (nam==fld)&&(typ=="Rational") = showJSON (Prelude.read $ unpack val :: Double)
+    | (nam==fld)&&(typ=="Bool") = showJSON (Prelude.read $ unpack val :: Int)
+    | (nam==fld)&&(typ=="Day") = showJSON val
+    | (nam==fld)&&(typ=="TimeOfDay") = showJSON val
+    | (nam==fld)&&(typ=="UTCTime") = showJSON val
+    | (nam==fld) = E.throw InvalidVariableTypeException
+    | otherwise = castJSType t fld val

@@ -48,7 +48,7 @@     | (name==arg) = E.throw MismatchedVariableTypeException
     | otherwise = findReplacement styp arg t
 replaceSubfieldVariables :: [(String,[(String,String)])] -> String -> [(String,String,String)] -> Field -> Field
-replaceSubfieldVariables sss sobj vars (Right (NestedObject alias name nsobj ss sfs)) = (Right $ NestedObject alias name sobj (if ss/=Nothing then (replaceScalarVariable (findScalars sss sobj) vars $ fromJust ss) else Nothing) [replaceSubfieldVariables sss nsobj vars sf | sf<-sfs]) :: Field
+replaceSubfieldVariables sss sobj vars (Right (NestedObject alias name nsobj ss sfs)) = (Right $ NestedObject alias name nsobj (if ss/=Nothing then (replaceScalarVariable (findScalars sss nsobj) vars $ fromJust ss) else Nothing) [replaceSubfieldVariables sss nsobj vars sf | sf<-sfs]) :: Field
 replaceSubfieldVariables sss sobj vars (Left (ScalarType alias name trans arg)) = if (isValue arg)&&(elem '$' $ getValue arg) then (Left (ScalarType alias name trans (Just $ findReplacement (findScalarType (findScalars sss sobj) name) (getValue arg) vars)) :: Field) else (Left (ScalarType alias name trans arg) :: Field)
 isValue :: Maybe String -> Bool
 isValue Nothing = False

@@ -12,7 +12,9 @@ makeSqlQueries [] _ _ = []
 makeSqlQueries (h:t) sodn sor = (makeSqlQuerySet h sodn sor):(makeSqlQueries t sodn sor)
 makeSqlQuerySet :: RootObject -> [(String,[String])] -> [(String,String,[String])] -> [String]
-makeSqlQuerySet obj sodn sor = if (length $ translateServerObjectToDBName (getServerObject obj) sodn)==1 then (addSqlQueryFields (getSubFields obj) (M.fromList [((head $ translateServerObjectToDBName (getServerObject obj) sodn),1)]) ("select "++(head $ translateServerObjectToDBName (getServerObject obj) sodn)++(show 1)++".id,") (" from"++(makeSqlTablePhrase obj (head $ translateServerObjectToDBName (getServerObject obj) sodn) 1)) (" order by "++(head $ translateServerObjectToDBName (getServerObject obj) sodn)++(show 1)++".id asc") (((head $ translateServerObjectToDBName (getServerObject obj) sodn)++(show 1)):[]) [] [(head $ translateServerObjectToDBName (getServerObject obj) sodn)] sodn sor) else (foldr (\x y -> x++y) [] [(addSqlQueryFields (getSubFields obj) (M.fromList [(x,1)]) ("select "++x++(show 1)++".id,") (" from"++(makeSqlTablePhrase obj x 1)) (" order by "++x++(show 1)++".id asc") ((x++(show 1)):[]) [] [x] sodn sor) | x<-(translateServerObjectToDBName (getServerObject obj) sodn)])
+makeSqlQuerySet obj sodn sor = if (length dbNames)==1 then (addSqlQueryFields (getSubFields obj) (M.fromList [((head dbNames),1)]) ("select "++(head dbNames)++(show 1)++".id,") (" from"++(makeSqlTablePhrase obj (head dbNames) 1)) (" order by "++(head dbNames)++(show 1)++".id asc") (((head dbNames)++(show 1)):[]) [] [(head dbNames)] sodn sor) else (foldr (\x y -> x++y) [] [(addSqlQueryFields (getSubFields obj) (M.fromList [(x,1)]) ("select "++x++(show 1)++".id,") (" from"++(makeSqlTablePhrase obj x 1)) (" order by "++x++(show 1)++".id asc") ((x++(show 1)):[]) [] [x] sodn sor) | x<-dbNames])
+                           where
+                             dbNames = translateServerObjectToDBName (getServerObject obj) sodn
 -- making table phrase when there is only one sql table
 makeSqlTablePhrase :: NestedObject -> String -> Int -> String
 makeSqlTablePhrase obj name number = if (withSubSelection obj)==True then " (select * from "++name++" where "++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj)++") as "++name++(show number) else " "++name++" as "++name++(show number)
@@ -21,11 +23,12 @@ addSqlQueryFields [] counts select from order [] (h:t) ltable _ _ = E.throw CreatingSqlQueryObjectFieldsException
 addSqlQueryFields [] counts select from order (h:t) [] ltable _ _ = [(removeLastChar select)++from++order++";"]
 addSqlQueryFields [] counts select from order (a:b) (h:t) ltable sodn sor = addSqlQueryFields h counts select from order b t ltable sodn sor
-addSqlQueryFields (h:t) counts select from order [] _ ltable _ _ = E.throw CreatingSqlQueryObjectFieldsException
+addSqlQueryFields (h:t) counts select from order [] [] ltable _ _ = E.throw CreatingSqlQueryObjectsException
+addSqlQueryFields (h:t) counts select from order [] (a:b) ltable _ _ = E.throw CreatingSqlQueryObjectsException
 addSqlQueryFields (h:t) counts select from order names fields ltable sodn sor
     | (isLeft h)==True = addSqlQueryFields t counts (select++(head names)++"."++(getScalarName $ fromLeft (E.throw InvalidScalarException) h)++",") from order names fields ltable sodn sor
     -- since only difference is table name, I should remove repeated computations by changing only name...
-    | tablesCount>1 = foldr (\x y -> x++y) [] [(addSqlQueryFields (getSubFields nobj) (calcNewCounts (head ltable) x) (select++x++(show $ (M.!) (calcNewCounts (head ltable) x) x)++".id,") (from++(makeTransitions (calcNewCounts (head ltable) x) (getDBObjectRelationships (head ltable) x sor) nobj)) (order++","++x++(show $ (M.!) (calcNewCounts (head ltable) x) x)++".id asc") ((x++(show $ (M.!) (calcNewCounts (head ltable) x) x)):names) (t:fields) [x]) sodn sor | x<-tables]
+    | tablesCount>1 = foldr (\x y -> x++y) [] [(addSqlQueryFields (getSubFields nobj) (calcNewCounts (head ltable) x) (select++x++(show $ (M.!) (calcNewCounts (head ltable) x) x)++".id,") (from++(makeTransitions (calcNewCounts (head ltable) x) (getDBObjectRelationships (head ltable) x sor) nobj)) (order++","++x++(show $ (M.!) (calcNewCounts (head ltable) x) x)++".id asc") ((x++(show $ (M.!) (calcNewCounts (head ltable) x) x)):names) (t:fields) [x] sodn sor) | x<-tables]
     | otherwise = addSqlQueryFields (getSubFields nobj) (calcNewCounts (head ltable) $ head tables) (select++(head tables)++(show $ (M.!) (calcNewCounts (head ltable) $ head tables) (head tables))++".id,") (from++(makeTransitions (calcNewCounts (head ltable) $ head tables) (getDBObjectRelationships (head ltable) (head tables) sor) nobj)) (order++","++(head tables)++(show $ (M.!) (calcNewCounts (head ltable) $ head tables) (head tables))++".id asc") (((head tables)++(show ((calcNewCounts (head ltable) $ head tables) M.! (head tables)))):names) (t:fields) [(head tables)] sodn sor
   where
     calcNewCounts :: String -> String -> M.Map String Int
@@ -53,4 +56,4 @@ completeTransition :: M.Map String Int -> [String] -> NestedObject -> String
 completeTransition counts (h1:h2:h3:h4:h5:[]) nobj = " inner join "++(if (withSubSelection nobj)==True then ("(select * from "++h1++" where "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")") else h1)++" as "++h1++(show $ (M.!) counts h1)++" on "++h3++(show $ (M.!) counts h3)++"."++h5++"="++h1++(show $ (M.!) counts h1)++"."++h2
 completeTransition counts (h1:h2:h3:h4:h5:h6:h7:h8:t) nobj = " inner join "++h6++" as "++h6++(show $ (M.!) counts h6)++" on "++h3++(show $ (M.!) counts h3)++"."++h5++"="++h6++(show $ (M.!) counts h6)++"."++h7++(completeTransition counts (h1:h2:h6:h7:h8:t) nobj)
-completeTransition counts _ _ = E.throw CreatingSqlQueryObjectFieldsException+completeTransition counts _ _ = E.throw RelationshipConfigurationException

@@ -374,7 +374,30 @@     * EOFDataProcessingException (when the given data is shorter than expected in reference to the given serve objects)
     * InvalidArgumentException (when there is an internal argument error - you should not observe this)
 -}
-processPersistentData :: [[[[Text]]]]  -- ^ database query return value as casted to only Text data types and with no other alterations (a list of GraphQL-grouped results list of SQL query results list of data row lists)
-                      -> [RootObject]  -- ^ unmodified server objects that was given by the previous processQueryString function.
-                      -> String        -- ^ The return value is a string type to describe the GraphQL-organized return values.
-processPersistentData dt ro = DP.processReturnedValues ro dt
+processPersistentData :: [(String,[(String,String)])]  -- ^ unique server object name to list of valid scalar subfields (which are exactly named after database column names) and the subfield type.
+                      -> [[[[Text]]]]                  -- ^ database query return value as casted to only Text data types and with no other alterations (a list of GraphQL-grouped results list of SQL query results list of data row lists)
+                      -> [RootObject]                  -- ^ unmodified server objects that was given by the previous processQueryString function.
+                      -> String                        -- ^ The return value is a string type to describe the GraphQL-organized return values.
+processPersistentData sss dt ro = DP.processReturnedValues sss ro dt
+
+{- | 
+    This is a json version from the above function. It is also wrapped in a monad
+
+    The exceptions thrown with this function are same as above function, but there are a few more...
+
+     * ImportSchemaException (when there is a problem with reading your schema)
+     * ImportSchemaServerNameException (when there is a problem with reading your servername argument)
+     * ImportSchemaPseudonymsException (when there is a problem with reading your pseudonyms list argument)
+     * ImportSchemaScalarFieldsException (when there is a problem with reading your scalarfields list argument)
+     * ImportSchemaObjectFieldsException (when there is a problem with reading your objectfields list argument)
+     * ImportSchemaDatabaseTablesException (when there is a problem with reading your databasetables list argument)
+     * ImportSchemaDatabaseRelationshipsException (when there is a problem with reading your databaserelationships list argument)
+-}
+processPersistentDataWithJson :: (MonadIO m)
+                              => FilePath      -- ^ This is the file path to schema json
+                              -> [[[[Text]]]]  -- ^ This is the unmodified Persistent database query return value (a list of GraphQL-grouped results list of SQL query results list of data row lists).
+                              -> [RootObject]  -- ^ This is the unmodified server objects that was composed from previous processQueryString function.
+                              -> m String      -- ^ The return value is a monad of string type to describe the GraphQL-organized return values.
+processPersistentDataWithJson fp dt ro = do
+                                      (_,sss,_,_,_) <- IO.liftIO $ JP.fetchArguments fp
+                                      return $ DP.processReturnedValues sss ro dt

@@ -36,7 +36,8 @@                       MismatchedVariableTypeException |
                       InvalidVariableTypeException |
                       ReadVariablesException |
-                      VariablesSyntaxException
+                      VariablesSyntaxException |
+                      ValueInterpretationException
   deriving Show
 
                       -- InvalidObjectNestedObjectFieldException |