hasura · lexi-lambda · Aug 28, 2019 · Aug 26, 2019 · Aug 26, 2019 · Aug 26, 2019
@@ -19,7 +19,7 @@ import qualified Data.Yaml.TH               as Y
 import qualified Database.PG.Query          as Q
 
 curCatalogVer :: T.Text
-curCatalogVer = "21"
+curCatalogVer = "22"
 
 migrateMetadata
   :: ( MonadTx m
@@ -354,6 +354,12 @@ from20To21 :: (MonadTx m) => m ()
 from20To21 = liftTx $ Q.catchE defaultTxErrorHandler $ do
   Q.unitQ "CREATE INDEX ON hdb_catalog.event_log (locked)" () False
 
+from21To22 :: (MonadTx m) => m ()
+from21To22 = do
+  Q.Discard () <- liftTx $ Q.multiQE defaultTxErrorHandler
+    $(Q.sqlFromFile "src-rsr/migrate_from_21_to_22.sql")
+  pure ()
+
 migrateCatalog
   :: ( MonadTx m
      , CacheRWM m
@@ -396,6 +402,7 @@ migrateCatalog migrationTime = migrateFrom =<< getCatalogVersion
           , ("18", from18To19)
           , ("19", from19To20)
           , ("20", from20To21)
+          , ("21", from21To22)
           ]
 
     postMigrate = do

@@ -5,7 +5,6 @@ module Hasura.GraphQL.Resolve.Mutation
   , buildEmptyMutResp
   ) where
 
-import           Control.Arrow                     (second)
 import           Data.Has
 import           Hasura.Prelude
 

@@ -13,7 +13,6 @@ module Hasura.GraphQL.Resolve.Select
   , toPGQuery
   ) where
 
-import           Control.Arrow                     (first)
 import           Data.Has
 import           Data.Parser.JSONPath
 import           Hasura.Prelude
@@ -413,13 +412,28 @@ convertAggSelect opCtx fld =
 
 parseFunctionArgs
   ::( MonadError QErr m)
-  => FuncArgSeq -> AnnInpVal -> m [UnresolvedVal]
-parseFunctionArgs argSeq val = fmap catMaybes $
-  flip withObject val $ \_ obj ->
-    fmap toList $ forM argSeq $ \(FuncArgItem argName) ->
-      forM (OMap.lookup argName obj) $ fmap (maybe nullSQL UVPG) . asPGColumnValueM
+  => FuncArgSeq
+  -> AnnInpVal
+  -> m (RS.FunctionArgsExpG UnresolvedVal)
+parseFunctionArgs argSeq val = flip withObject val $ \_ obj -> do
+  (positionalArgs, argsLeft) <- spanMaybeM (parsePositionalArg obj) argSeq
+  namedArgs <- Map.fromList . catMaybes <$> traverse (parseNamedArg obj) argsLeft
+  pure $ RS.FunctionArgsExp positionalArgs namedArgs
   where
-    nullSQL = UVSQL $ S.SEUnsafe "NULL"
+    parsePositionalArg obj (FuncArgItem gqlName _ _) =
+      maybe (pure Nothing) (fmap Just . parseArg) $ OMap.lookup gqlName obj
+
+    parseArg = fmap (maybe (UVSQL S.SENull) UVPG) . asPGColumnValueM
+
+    parseNamedArg obj (FuncArgItem gqlName maybeSqlName hasDefault) =
+      case OMap.lookup gqlName obj of
+        Just argInpVal -> case maybeSqlName of
+          Just sqlName -> Just . (getFuncArgNameTxt sqlName,) <$> parseArg argInpVal
+          Nothing -> throw400 NotSupported
+                     "Only last set of positional arguments can be omitted"
+        Nothing -> if not hasDefault then
+                     throw400 NotSupported "Non default arguments cannot be omitted"
+                   else pure Nothing
 
 fromFuncQueryField
   :: (MonadError QErr m)
@@ -429,7 +443,7 @@ fromFuncQueryField
   -> m (RS.AnnFnSelG s UnresolvedVal)
 fromFuncQueryField fn qf argSeq fld = fieldAsPath fld $ do
   funcArgsM <- withArgM (_fArguments fld) "args" $ parseFunctionArgs argSeq
-  let funcArgs = fromMaybe [] funcArgsM
+  let funcArgs = fromMaybe RS.emptyFunctionArgsExp funcArgsM
   RS.AnnFnSel qf funcArgs <$> fn fld
 
 convertFuncQuerySimple

@@ -109,9 +109,12 @@ type OrdByItemMap = Map.HashMap G.Name OrdByItem
 
 type OrdByCtx = Map.HashMap G.NamedType OrdByItemMap
 
-newtype FuncArgItem
-  = FuncArgItem {getArgName :: G.Name}
-  deriving (Show, Eq)
+data FuncArgItem
+  = FuncArgItem
+  { _faiInputArgName :: !G.Name
+  , _faiSqlArgName   :: !(Maybe FunctionArgName)
+  , _faiHasDefault   :: !Bool
+  } deriving (Show, Eq)
 
 type FuncArgSeq = Seq.Seq FuncArgItem
 

@@ -17,7 +17,7 @@ module Hasura.GraphQL.Schema
   , checkSchemaConflicts
   ) where
 
-import           Control.Lens.Extended          hiding (op)
+import           Control.Lens.Extended                 hiding (op)
 
 import qualified Data.HashMap.Strict                   as Map
 import qualified Data.HashSet                          as Set
@@ -37,13 +37,13 @@ import           Hasura.SQL.Types
 import           Hasura.GraphQL.Schema.BoolExp
 import           Hasura.GraphQL.Schema.Common
 import           Hasura.GraphQL.Schema.Function
+import           Hasura.GraphQL.Schema.Merge
 import           Hasura.GraphQL.Schema.Mutation.Common
 import           Hasura.GraphQL.Schema.Mutation.Delete
 import           Hasura.GraphQL.Schema.Mutation.Insert
 import           Hasura.GraphQL.Schema.Mutation.Update
 import           Hasura.GraphQL.Schema.OrderBy
 import           Hasura.GraphQL.Schema.Select
-import           Hasura.GraphQL.Schema.Merge
 
 getInsPerm :: TableInfo PGColumnInfo -> RoleName -> Maybe InsPermInfo
 getInsPerm tabInfo role
@@ -375,8 +375,8 @@ getRootFldsRole' tn primCols constraints fields funcs insM selM updM delM viM =
       , g fi
       )
 
-    mkFuncArgItemSeq fi = Seq.fromList $
-      procFuncArgs (fiInputArgs fi) $ \_ t -> FuncArgItem $ G.Name t
+    mkFuncArgItemSeq fi = Seq.fromList $ procFuncArgs (fiInputArgs fi)
+                          $ \fa t -> FuncArgItem (G.Name t) (faName fa) (faHasDefault fa)
 
 
 getSelPermission :: TableInfo PGColumnInfo -> RoleName -> Maybe SelPermInfo
@@ -636,7 +636,7 @@ instance Monoid TyAgg where
 -- | A role-specific mapping from root field names to allowed operations.
 data RootFields
   = RootFields
-  { rootQueryFields :: !(Map.HashMap G.Name (QueryCtx, ObjFldInfo))
+  { rootQueryFields    :: !(Map.HashMap G.Name (QueryCtx, ObjFldInfo))
   , rootMutationFields :: !(Map.HashMap G.Name (MutationCtx, ObjFldInfo))
   } deriving (Show, Eq)
 

@@ -36,18 +36,18 @@ input function_args {
 
 procFuncArgs
   :: Seq.Seq FunctionArg
-  -> (PGScalarType -> Text -> a) -> [a]
+  -> (FunctionArg -> Text -> a) -> [a]
 procFuncArgs argSeq f =
   fst $ foldl mkItem ([], 1::Int) argSeq
   where
-    mkItem (items, argNo) (FunctionArg nameM ty) =
-      case nameM of
+    mkItem (items, argNo) fa =
+      case faName fa of
         Just argName ->
           let argT = getFuncArgNameTxt argName
-          in (items <> pure (f ty argT), argNo)
+          in (items <> pure (f fa argT), argNo)
         Nothing ->
           let argT = "arg_" <> T.pack (show argNo)
-          in (items <> pure (f ty argT), argNo + 1)
+          in (items <> pure (f fa argT), argNo + 1)
 
 mkFuncArgsInp :: FunctionInfo -> Maybe InpObjTyInfo
 mkFuncArgsInp funcInfo =
@@ -62,9 +62,9 @@ mkFuncArgsInp funcInfo =
 
     argInps = procFuncArgs funcArgs mkInpVal
 
-    mkInpVal ty t =
+    mkInpVal fa t =
       InpValInfo Nothing (G.Name t) Nothing $
-      G.toGT $ mkScalarTy ty
+      G.toGT $ mkScalarTy $ faType fa
 
 {-
 

@@ -6,9 +6,11 @@ module Hasura.Prelude
   , choice
   , bsToTxt
   , txtToBs
+  , spanMaybeM
   ) where
 
 import           Control.Applicative        as M (Alternative (..))
+import           Control.Arrow              as M (first, second, (&&&), (***))
 import           Control.Monad              as M (void, when)
 import           Control.Monad.Base         as M
 import           Control.Monad.Except       as M
@@ -20,7 +22,7 @@ import           Data.Bool                  as M (bool)
 import           Data.Data                  as M (Data (..))
 import           Data.Either                as M (lefts, partitionEithers,
                                                   rights)
-import           Data.Foldable              as M (foldrM, for_, toList,
+import           Data.Foldable              as M (asum, foldrM, for_, toList,
                                                   traverse_)
 import           Data.Function              as M (on, (&))
 import           Data.Functor               as M (($>), (<&>))
@@ -56,10 +58,21 @@ onLeft :: (Monad m) => Either e a -> (e -> m a) -> m a
 onLeft e f = either f return e
 
 choice :: (Alternative f) => [f a] -> f a
-choice = foldr (<|>) empty
+choice = asum
 
 bsToTxt :: B.ByteString -> Text
 bsToTxt = TE.decodeUtf8With TE.lenientDecode
 
 txtToBs :: Text -> B.ByteString
 txtToBs = TE.encodeUtf8
+
+-- Like 'span', but monadic and with a function that produces 'Maybe' instead of 'Bool'
+spanMaybeM
+  :: (Foldable f, Monad m)
+  => (a -> m (Maybe b)) -> f a -> m ([b], [a])
+spanMaybeM f = go . toList
+  where
+    go []     = pure ([], [])
+    go l@(x:xs) = f x >>= \case
+      Just y  -> first (y:) <$> go xs
+      Nothing -> pure ([], l)
@@ -61,7 +61,6 @@ import           Hasura.SQL.Types
 import qualified Database.PG.Query                  as Q
 import qualified Hasura.SQL.DML                     as S
 
-import           Control.Arrow                      (first)
 import           Data.Aeson
 import           Data.Aeson.Casing
 import           Data.Aeson.TH

@@ -29,7 +29,6 @@ import           Hasura.SQL.Types
 
 import qualified Database.PG.Query   as Q
 
-import           Control.Arrow       ((***))
 import           Data.Aeson.Casing
 import           Data.Aeson.TH
 

@@ -44,19 +44,27 @@ data RawFuncInfo
   , rfiReturnsSet       :: !Bool
   , rfiInputArgTypes    :: ![PGScalarType]
   , rfiInputArgNames    :: ![T.Text]
+  , rfiDefaultArgs      :: !Int
   , rfiReturnsTable     :: !Bool
   } deriving (Show, Eq)
 $(deriveJSON (aesonDrop 3 snakeCase) ''RawFuncInfo)
 
-mkFunctionArgs :: [PGScalarType] -> [T.Text] -> [FunctionArg]
-mkFunctionArgs tys argNames =
+mkFunctionArgs :: Int -> [PGScalarType] -> [T.Text] -> [FunctionArg]
+mkFunctionArgs defArgsNo tys argNames =
   bool withNames withNoNames $ null argNames
   where
-    withNoNames = flip map tys $ \ty -> FunctionArg Nothing ty
-    withNames = zipWith mkArg argNames tys
+    hasDefaultBoolSeq = replicate (length argNames - defArgsNo) False
+                        -- only last arguments can have default expression
+                        <> replicate defArgsNo True
 
-    mkArg "" ty = FunctionArg Nothing ty
-    mkArg n  ty = flip FunctionArg ty $ Just $ FunctionArgName n
+    tysWithHasDefault = zip tys hasDefaultBoolSeq
+
+    withNoNames = flip map tysWithHasDefault $
+                  \(ty, hasDef) -> FunctionArg Nothing ty hasDef
+    withNames = zipWith mkArg argNames tysWithHasDefault
+
+    mkArg "" (ty, hasDef) = FunctionArg Nothing ty hasDef
+    mkArg n  (ty, hasDef) = FunctionArg (Just $ FunctionArgName n) ty hasDef
 
 validateFuncArgs :: MonadError QErr m => [FunctionArg] -> m ()
 validateFuncArgs args =
@@ -81,7 +89,7 @@ mkFunctionInfo qf rawFuncInfo = do
   -- throw error if function type is VOLATILE
   when (funTy == FTVOLATILE) $ throw400 NotSupported "function of type \"VOLATILE\" is not supported now"
 
-  let funcArgs = mkFunctionArgs inpArgTyps inpArgNames
+  let funcArgs = mkFunctionArgs defArgsNo inpArgTyps inpArgNames
   validateFuncArgs funcArgs
 
   let funcArgsSeq = Seq.fromList funcArgs
@@ -90,7 +98,7 @@ mkFunctionInfo qf rawFuncInfo = do
   return $ FunctionInfo qf False funTy funcArgsSeq retTable [dep]
   where
     RawFuncInfo hasVariadic funTy retSn retN retTyTyp
-                retSet inpArgTyps inpArgNames returnsTab
+                retSet inpArgTyps inpArgNames defArgsNo returnsTab
                 = rawFuncInfo
 
 saveFunctionToCatalog :: QualifiedFunction -> Bool -> Q.TxE QErr ()

@@ -8,7 +8,6 @@ module Hasura.RQL.DDL.Schema.Rename
   )
 where
 
-import           Control.Arrow                      ((***))
 import           Hasura.Prelude
 import qualified Hasura.RQL.DDL.EventTrigger        as DS
 import           Hasura.RQL.DDL.Permission

@@ -6,7 +6,6 @@ module Hasura.RQL.DML.Select.Internal
   )
 where
 
-import           Control.Arrow               ((&&&))
 import           Data.List                   (delete, sort)
 import           Instances.TH.Lift           ()
 
@@ -718,7 +717,10 @@ mkFuncSelectWith f annFn =
     funcSel = S.mkSelect { S.selFrom = Just $ S.FromExp [frmItem]
                          , S.selExtr = [S.Extractor S.SEStar Nothing]
                          }
-    frmItem = S.mkFuncFromItem qf fnArgs
+    frmItem = S.mkFuncFromItem qf $ mkSQLFunctionArgs fnArgs
+
+    mkSQLFunctionArgs (FunctionArgsExp positional named) =
+      S.FunctionArgs positional named
 
     newTabFrom = (_asnFrom annSel) {_tfIden = Just $ toIden funcAls}
 

@@ -275,10 +275,21 @@ type AnnSimpleSel = AnnSimpleSelG S.SQLExp
 type AnnAggSelG v = AnnSelG (TableAggFldsG v) v
 type AnnAggSel = AnnAggSelG S.SQLExp
 
+data FunctionArgsExpG a
+  = FunctionArgsExp
+  { _faePositional :: ![a]
+  , _faeNamed      :: !(HM.HashMap Text a)
+  } deriving (Show, Eq, Functor, Foldable, Traversable)
+
+emptyFunctionArgsExp :: FunctionArgsExpG a
+emptyFunctionArgsExp = FunctionArgsExp [] HM.empty
+
+type FunctionArgExp = FunctionArgsExpG S.SQLExp
+
 data AnnFnSelG s v
   = AnnFnSel
   { _afFn     :: !QualifiedFunction
-  , _afFnArgs :: ![v]
+  , _afFnArgs :: !(FunctionArgsExpG v)
   , _afSelect :: !s
   } deriving (Show, Eq)
 

@@ -21,6 +21,8 @@ module Hasura.RQL.Types.Common
        , unNonEmptyText
        , adminText
        , rootText
+
+       , FunctionArgName(..)
        ) where
 
 import           Hasura.Prelude
@@ -174,3 +176,7 @@ data ForeignKey
 $(deriveJSON (aesonDrop 3 snakeCase) ''ForeignKey)
 
 instance Hashable ForeignKey
+
+newtype FunctionArgName =
+  FunctionArgName { getFuncArgNameTxt :: T.Text}
+  deriving (Show, Eq, ToJSON)
@@ -355,14 +355,11 @@ funcTypToTxt FTSTABLE    = "STABLE"
 instance Show FunctionType where
   show = T.unpack . funcTypToTxt
 
-newtype FunctionArgName =
-  FunctionArgName { getFuncArgNameTxt :: T.Text}
-  deriving (Show, Eq, ToJSON)
-
 data FunctionArg
   = FunctionArg
-  { faName :: !(Maybe FunctionArgName)
-  , faType :: !PGScalarType
+  { faName       :: !(Maybe FunctionArgName)
+  , faType       :: !PGScalarType
+  , faHasDefault :: !Bool
   } deriving (Show, Eq)
 
 $(deriveToJSON (aesonDrop 2 snakeCase) ''FunctionArg)