{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}

module PostgREST.DbStructure.Proc
  ( PgArg(..)
  , PgType(..)
  , ProcDescription(..)
  , ProcVolatility(..)
  , ProcsMap
  , RetType(..)
  , procReturnsScalar
  , procReturnsSingle
  , procTableName
  , specifiedProcArgs
  ) where

import qualified Data.Aeson          as JSON
import qualified Data.HashMap.Strict as M
import qualified Data.Set            as S

import PostgREST.DbStructure.Identifiers (FieldName,
                                          QualifiedIdentifier (..),
                                          Schema, TableName)

import Protolude


data PgArg = PgArg
  { PgArg -> Text
pgaName :: Text
  , PgArg -> Text
pgaType :: Text
  , PgArg -> Bool
pgaReq  :: Bool
  , PgArg -> Bool
pgaVar  :: Bool
  }
  deriving (PgArg -> PgArg -> Bool
(PgArg -> PgArg -> Bool) -> (PgArg -> PgArg -> Bool) -> Eq PgArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgArg -> PgArg -> Bool
$c/= :: PgArg -> PgArg -> Bool
== :: PgArg -> PgArg -> Bool
$c== :: PgArg -> PgArg -> Bool
Eq, Eq PgArg
Eq PgArg
-> (PgArg -> PgArg -> Ordering)
-> (PgArg -> PgArg -> Bool)
-> (PgArg -> PgArg -> Bool)
-> (PgArg -> PgArg -> Bool)
-> (PgArg -> PgArg -> Bool)
-> (PgArg -> PgArg -> PgArg)
-> (PgArg -> PgArg -> PgArg)
-> Ord PgArg
PgArg -> PgArg -> Bool
PgArg -> PgArg -> Ordering
PgArg -> PgArg -> PgArg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PgArg -> PgArg -> PgArg
$cmin :: PgArg -> PgArg -> PgArg
max :: PgArg -> PgArg -> PgArg
$cmax :: PgArg -> PgArg -> PgArg
>= :: PgArg -> PgArg -> Bool
$c>= :: PgArg -> PgArg -> Bool
> :: PgArg -> PgArg -> Bool
$c> :: PgArg -> PgArg -> Bool
<= :: PgArg -> PgArg -> Bool
$c<= :: PgArg -> PgArg -> Bool
< :: PgArg -> PgArg -> Bool
$c< :: PgArg -> PgArg -> Bool
compare :: PgArg -> PgArg -> Ordering
$ccompare :: PgArg -> PgArg -> Ordering
$cp1Ord :: Eq PgArg
Ord, (forall x. PgArg -> Rep PgArg x)
-> (forall x. Rep PgArg x -> PgArg) -> Generic PgArg
forall x. Rep PgArg x -> PgArg
forall x. PgArg -> Rep PgArg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PgArg x -> PgArg
$cfrom :: forall x. PgArg -> Rep PgArg x
Generic, [PgArg] -> Encoding
[PgArg] -> Value
PgArg -> Encoding
PgArg -> Value
(PgArg -> Value)
-> (PgArg -> Encoding)
-> ([PgArg] -> Value)
-> ([PgArg] -> Encoding)
-> ToJSON PgArg
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PgArg] -> Encoding
$ctoEncodingList :: [PgArg] -> Encoding
toJSONList :: [PgArg] -> Value
$ctoJSONList :: [PgArg] -> Value
toEncoding :: PgArg -> Encoding
$ctoEncoding :: PgArg -> Encoding
toJSON :: PgArg -> Value
$ctoJSON :: PgArg -> Value
JSON.ToJSON)

data PgType
  = Scalar
  | Composite QualifiedIdentifier
  deriving (PgType -> PgType -> Bool
(PgType -> PgType -> Bool)
-> (PgType -> PgType -> Bool) -> Eq PgType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgType -> PgType -> Bool
$c/= :: PgType -> PgType -> Bool
== :: PgType -> PgType -> Bool
$c== :: PgType -> PgType -> Bool
Eq, Eq PgType
Eq PgType
-> (PgType -> PgType -> Ordering)
-> (PgType -> PgType -> Bool)
-> (PgType -> PgType -> Bool)
-> (PgType -> PgType -> Bool)
-> (PgType -> PgType -> Bool)
-> (PgType -> PgType -> PgType)
-> (PgType -> PgType -> PgType)
-> Ord PgType
PgType -> PgType -> Bool
PgType -> PgType -> Ordering
PgType -> PgType -> PgType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PgType -> PgType -> PgType
$cmin :: PgType -> PgType -> PgType
max :: PgType -> PgType -> PgType
$cmax :: PgType -> PgType -> PgType
>= :: PgType -> PgType -> Bool
$c>= :: PgType -> PgType -> Bool
> :: PgType -> PgType -> Bool
$c> :: PgType -> PgType -> Bool
<= :: PgType -> PgType -> Bool
$c<= :: PgType -> PgType -> Bool
< :: PgType -> PgType -> Bool
$c< :: PgType -> PgType -> Bool
compare :: PgType -> PgType -> Ordering
$ccompare :: PgType -> PgType -> Ordering
$cp1Ord :: Eq PgType
Ord, (forall x. PgType -> Rep PgType x)
-> (forall x. Rep PgType x -> PgType) -> Generic PgType
forall x. Rep PgType x -> PgType
forall x. PgType -> Rep PgType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PgType x -> PgType
$cfrom :: forall x. PgType -> Rep PgType x
Generic, [PgType] -> Encoding
[PgType] -> Value
PgType -> Encoding
PgType -> Value
(PgType -> Value)
-> (PgType -> Encoding)
-> ([PgType] -> Value)
-> ([PgType] -> Encoding)
-> ToJSON PgType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PgType] -> Encoding
$ctoEncodingList :: [PgType] -> Encoding
toJSONList :: [PgType] -> Value
$ctoJSONList :: [PgType] -> Value
toEncoding :: PgType -> Encoding
$ctoEncoding :: PgType -> Encoding
toJSON :: PgType -> Value
$ctoJSON :: PgType -> Value
JSON.ToJSON)

data RetType
  = Single PgType
  | SetOf PgType
  deriving (RetType -> RetType -> Bool
(RetType -> RetType -> Bool)
-> (RetType -> RetType -> Bool) -> Eq RetType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetType -> RetType -> Bool
$c/= :: RetType -> RetType -> Bool
== :: RetType -> RetType -> Bool
$c== :: RetType -> RetType -> Bool
Eq, Eq RetType
Eq RetType
-> (RetType -> RetType -> Ordering)
-> (RetType -> RetType -> Bool)
-> (RetType -> RetType -> Bool)
-> (RetType -> RetType -> Bool)
-> (RetType -> RetType -> Bool)
-> (RetType -> RetType -> RetType)
-> (RetType -> RetType -> RetType)
-> Ord RetType
RetType -> RetType -> Bool
RetType -> RetType -> Ordering
RetType -> RetType -> RetType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RetType -> RetType -> RetType
$cmin :: RetType -> RetType -> RetType
max :: RetType -> RetType -> RetType
$cmax :: RetType -> RetType -> RetType
>= :: RetType -> RetType -> Bool
$c>= :: RetType -> RetType -> Bool
> :: RetType -> RetType -> Bool
$c> :: RetType -> RetType -> Bool
<= :: RetType -> RetType -> Bool
$c<= :: RetType -> RetType -> Bool
< :: RetType -> RetType -> Bool
$c< :: RetType -> RetType -> Bool
compare :: RetType -> RetType -> Ordering
$ccompare :: RetType -> RetType -> Ordering
$cp1Ord :: Eq RetType
Ord, (forall x. RetType -> Rep RetType x)
-> (forall x. Rep RetType x -> RetType) -> Generic RetType
forall x. Rep RetType x -> RetType
forall x. RetType -> Rep RetType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RetType x -> RetType
$cfrom :: forall x. RetType -> Rep RetType x
Generic, [RetType] -> Encoding
[RetType] -> Value
RetType -> Encoding
RetType -> Value
(RetType -> Value)
-> (RetType -> Encoding)
-> ([RetType] -> Value)
-> ([RetType] -> Encoding)
-> ToJSON RetType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RetType] -> Encoding
$ctoEncodingList :: [RetType] -> Encoding
toJSONList :: [RetType] -> Value
$ctoJSONList :: [RetType] -> Value
toEncoding :: RetType -> Encoding
$ctoEncoding :: RetType -> Encoding
toJSON :: RetType -> Value
$ctoJSON :: RetType -> Value
JSON.ToJSON)

data ProcVolatility
  = Volatile
  | Stable
  | Immutable
  deriving (ProcVolatility -> ProcVolatility -> Bool
(ProcVolatility -> ProcVolatility -> Bool)
-> (ProcVolatility -> ProcVolatility -> Bool) -> Eq ProcVolatility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcVolatility -> ProcVolatility -> Bool
$c/= :: ProcVolatility -> ProcVolatility -> Bool
== :: ProcVolatility -> ProcVolatility -> Bool
$c== :: ProcVolatility -> ProcVolatility -> Bool
Eq, Eq ProcVolatility
Eq ProcVolatility
-> (ProcVolatility -> ProcVolatility -> Ordering)
-> (ProcVolatility -> ProcVolatility -> Bool)
-> (ProcVolatility -> ProcVolatility -> Bool)
-> (ProcVolatility -> ProcVolatility -> Bool)
-> (ProcVolatility -> ProcVolatility -> Bool)
-> (ProcVolatility -> ProcVolatility -> ProcVolatility)
-> (ProcVolatility -> ProcVolatility -> ProcVolatility)
-> Ord ProcVolatility
ProcVolatility -> ProcVolatility -> Bool
ProcVolatility -> ProcVolatility -> Ordering
ProcVolatility -> ProcVolatility -> ProcVolatility
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ProcVolatility -> ProcVolatility -> ProcVolatility
$cmin :: ProcVolatility -> ProcVolatility -> ProcVolatility
max :: ProcVolatility -> ProcVolatility -> ProcVolatility
$cmax :: ProcVolatility -> ProcVolatility -> ProcVolatility
>= :: ProcVolatility -> ProcVolatility -> Bool
$c>= :: ProcVolatility -> ProcVolatility -> Bool
> :: ProcVolatility -> ProcVolatility -> Bool
$c> :: ProcVolatility -> ProcVolatility -> Bool
<= :: ProcVolatility -> ProcVolatility -> Bool
$c<= :: ProcVolatility -> ProcVolatility -> Bool
< :: ProcVolatility -> ProcVolatility -> Bool
$c< :: ProcVolatility -> ProcVolatility -> Bool
compare :: ProcVolatility -> ProcVolatility -> Ordering
$ccompare :: ProcVolatility -> ProcVolatility -> Ordering
$cp1Ord :: Eq ProcVolatility
Ord, (forall x. ProcVolatility -> Rep ProcVolatility x)
-> (forall x. Rep ProcVolatility x -> ProcVolatility)
-> Generic ProcVolatility
forall x. Rep ProcVolatility x -> ProcVolatility
forall x. ProcVolatility -> Rep ProcVolatility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProcVolatility x -> ProcVolatility
$cfrom :: forall x. ProcVolatility -> Rep ProcVolatility x
Generic, [ProcVolatility] -> Encoding
[ProcVolatility] -> Value
ProcVolatility -> Encoding
ProcVolatility -> Value
(ProcVolatility -> Value)
-> (ProcVolatility -> Encoding)
-> ([ProcVolatility] -> Value)
-> ([ProcVolatility] -> Encoding)
-> ToJSON ProcVolatility
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ProcVolatility] -> Encoding
$ctoEncodingList :: [ProcVolatility] -> Encoding
toJSONList :: [ProcVolatility] -> Value
$ctoJSONList :: [ProcVolatility] -> Value
toEncoding :: ProcVolatility -> Encoding
$ctoEncoding :: ProcVolatility -> Encoding
toJSON :: ProcVolatility -> Value
$ctoJSON :: ProcVolatility -> Value
JSON.ToJSON)

data ProcDescription = ProcDescription
  { ProcDescription -> Text
pdSchema      :: Schema
  , ProcDescription -> Text
pdName        :: Text
  , ProcDescription -> Maybe Text
pdDescription :: Maybe Text
  , ProcDescription -> [PgArg]
pdArgs        :: [PgArg]
  , ProcDescription -> RetType
pdReturnType  :: RetType
  , ProcDescription -> ProcVolatility
pdVolatility  :: ProcVolatility
  , ProcDescription -> Bool
pdHasVariadic :: Bool
  }
  deriving (ProcDescription -> ProcDescription -> Bool
(ProcDescription -> ProcDescription -> Bool)
-> (ProcDescription -> ProcDescription -> Bool)
-> Eq ProcDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcDescription -> ProcDescription -> Bool
$c/= :: ProcDescription -> ProcDescription -> Bool
== :: ProcDescription -> ProcDescription -> Bool
$c== :: ProcDescription -> ProcDescription -> Bool
Eq, (forall x. ProcDescription -> Rep ProcDescription x)
-> (forall x. Rep ProcDescription x -> ProcDescription)
-> Generic ProcDescription
forall x. Rep ProcDescription x -> ProcDescription
forall x. ProcDescription -> Rep ProcDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProcDescription x -> ProcDescription
$cfrom :: forall x. ProcDescription -> Rep ProcDescription x
Generic, [ProcDescription] -> Encoding
[ProcDescription] -> Value
ProcDescription -> Encoding
ProcDescription -> Value
(ProcDescription -> Value)
-> (ProcDescription -> Encoding)
-> ([ProcDescription] -> Value)
-> ([ProcDescription] -> Encoding)
-> ToJSON ProcDescription
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ProcDescription] -> Encoding
$ctoEncodingList :: [ProcDescription] -> Encoding
toJSONList :: [ProcDescription] -> Value
$ctoJSONList :: [ProcDescription] -> Value
toEncoding :: ProcDescription -> Encoding
$ctoEncoding :: ProcDescription -> Encoding
toJSON :: ProcDescription -> Value
$ctoJSON :: ProcDescription -> Value
JSON.ToJSON)

-- Order by least number of args in the case of overloaded functions
instance Ord ProcDescription where
  ProcDescription Text
schema1 Text
name1 Maybe Text
des1 [PgArg]
args1 RetType
rt1 ProcVolatility
vol1 Bool
hasVar1 compare :: ProcDescription -> ProcDescription -> Ordering
`compare` ProcDescription Text
schema2 Text
name2 Maybe Text
des2 [PgArg]
args2 RetType
rt2 ProcVolatility
vol2 Bool
hasVar2
    | Text
schema1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
schema2 Bool -> Bool -> Bool
&& Text
name1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name2 Bool -> Bool -> Bool
&& [PgArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PgArg]
args1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [PgArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PgArg]
args2  = Ordering
LT
    | Text
schema2 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
schema2 Bool -> Bool -> Bool
&& Text
name1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name2 Bool -> Bool -> Bool
&& [PgArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PgArg]
args1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [PgArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PgArg]
args2  = Ordering
GT
    | Bool
otherwise = (Text
schema1, Text
name1, Maybe Text
des1, [PgArg]
args1, RetType
rt1, ProcVolatility
vol1, Bool
hasVar1) (Text, Text, Maybe Text, [PgArg], RetType, ProcVolatility, Bool)
-> (Text, Text, Maybe Text, [PgArg], RetType, ProcVolatility, Bool)
-> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Text
schema2, Text
name2, Maybe Text
des2, [PgArg]
args2, RetType
rt2, ProcVolatility
vol2, Bool
hasVar2)

-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
-- | It uses a HashMap for a faster lookup.
type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]

{-|
  Search the procedure parameters by matching them with the specified keys.
  If the key doesn't match a parameter, a parameter with a default type "text" is assumed.
-}
specifiedProcArgs :: S.Set FieldName -> ProcDescription -> [PgArg]
specifiedProcArgs :: Set Text -> ProcDescription -> [PgArg]
specifiedProcArgs Set Text
keys ProcDescription
proc =
  (\Text
k -> PgArg -> Maybe PgArg -> PgArg
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text -> Bool -> Bool -> PgArg
PgArg Text
k Text
"text" Bool
True Bool
False) ((PgArg -> Bool) -> [PgArg] -> Maybe PgArg
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
k (Text -> Bool) -> (PgArg -> Text) -> PgArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgArg -> Text
pgaName) (ProcDescription -> [PgArg]
pdArgs ProcDescription
proc))) (Text -> PgArg) -> [Text] -> [PgArg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
keys

procReturnsScalar :: ProcDescription -> Bool
procReturnsScalar :: ProcDescription -> Bool
procReturnsScalar ProcDescription
proc = case ProcDescription
proc of
  ProcDescription{pdReturnType :: ProcDescription -> RetType
pdReturnType = (Single PgType
Scalar)} -> Bool
True
  ProcDescription{pdReturnType :: ProcDescription -> RetType
pdReturnType = (SetOf PgType
Scalar)}  -> Bool
True
  ProcDescription
_                                               -> Bool
False

procReturnsSingle :: ProcDescription -> Bool
procReturnsSingle :: ProcDescription -> Bool
procReturnsSingle ProcDescription
proc = case ProcDescription
proc of
  ProcDescription{pdReturnType :: ProcDescription -> RetType
pdReturnType = (Single PgType
_)} -> Bool
True
  ProcDescription
_                                          -> Bool
False

procTableName :: ProcDescription -> Maybe TableName
procTableName :: ProcDescription -> Maybe Text
procTableName ProcDescription
proc = case ProcDescription -> RetType
pdReturnType ProcDescription
proc of
  SetOf  (Composite QualifiedIdentifier
qi) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ QualifiedIdentifier -> Text
qiName QualifiedIdentifier
qi
  Single (Composite QualifiedIdentifier
qi) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ QualifiedIdentifier -> Text
qiName QualifiedIdentifier
qi
  RetType
_                     -> Maybe Text
forall a. Maybe a
Nothing