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

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

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

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

import Protolude

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 -> Schema
pdSchema      :: Schema
  , ProcDescription -> Schema
pdName        :: Text
  , ProcDescription -> Maybe Schema
pdDescription :: Maybe Text
  , ProcDescription -> [ProcParam]
pdParams      :: [ProcParam]
  , 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)

data ProcParam = ProcParam
  { ProcParam -> Schema
ppName :: Text
  , ProcParam -> Schema
ppType :: Text
  , ProcParam -> Bool
ppReq  :: Bool
  , ProcParam -> Bool
ppVar  :: Bool
  }
  deriving (ProcParam -> ProcParam -> Bool
(ProcParam -> ProcParam -> Bool)
-> (ProcParam -> ProcParam -> Bool) -> Eq ProcParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcParam -> ProcParam -> Bool
$c/= :: ProcParam -> ProcParam -> Bool
== :: ProcParam -> ProcParam -> Bool
$c== :: ProcParam -> ProcParam -> Bool
Eq, Eq ProcParam
Eq ProcParam
-> (ProcParam -> ProcParam -> Ordering)
-> (ProcParam -> ProcParam -> Bool)
-> (ProcParam -> ProcParam -> Bool)
-> (ProcParam -> ProcParam -> Bool)
-> (ProcParam -> ProcParam -> Bool)
-> (ProcParam -> ProcParam -> ProcParam)
-> (ProcParam -> ProcParam -> ProcParam)
-> Ord ProcParam
ProcParam -> ProcParam -> Bool
ProcParam -> ProcParam -> Ordering
ProcParam -> ProcParam -> ProcParam
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 :: ProcParam -> ProcParam -> ProcParam
$cmin :: ProcParam -> ProcParam -> ProcParam
max :: ProcParam -> ProcParam -> ProcParam
$cmax :: ProcParam -> ProcParam -> ProcParam
>= :: ProcParam -> ProcParam -> Bool
$c>= :: ProcParam -> ProcParam -> Bool
> :: ProcParam -> ProcParam -> Bool
$c> :: ProcParam -> ProcParam -> Bool
<= :: ProcParam -> ProcParam -> Bool
$c<= :: ProcParam -> ProcParam -> Bool
< :: ProcParam -> ProcParam -> Bool
$c< :: ProcParam -> ProcParam -> Bool
compare :: ProcParam -> ProcParam -> Ordering
$ccompare :: ProcParam -> ProcParam -> Ordering
$cp1Ord :: Eq ProcParam
Ord, (forall x. ProcParam -> Rep ProcParam x)
-> (forall x. Rep ProcParam x -> ProcParam) -> Generic ProcParam
forall x. Rep ProcParam x -> ProcParam
forall x. ProcParam -> Rep ProcParam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProcParam x -> ProcParam
$cfrom :: forall x. ProcParam -> Rep ProcParam x
Generic, [ProcParam] -> Encoding
[ProcParam] -> Value
ProcParam -> Encoding
ProcParam -> Value
(ProcParam -> Value)
-> (ProcParam -> Encoding)
-> ([ProcParam] -> Value)
-> ([ProcParam] -> Encoding)
-> ToJSON ProcParam
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ProcParam] -> Encoding
$ctoEncodingList :: [ProcParam] -> Encoding
toJSONList :: [ProcParam] -> Value
$ctoJSONList :: [ProcParam] -> Value
toEncoding :: ProcParam -> Encoding
$ctoEncoding :: ProcParam -> Encoding
toJSON :: ProcParam -> Value
$ctoJSON :: ProcParam -> Value
JSON.ToJSON)

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

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 Schema
procTableName ProcDescription
proc = case ProcDescription -> RetType
pdReturnType ProcDescription
proc of
  SetOf  (Composite QualifiedIdentifier
qi) -> Schema -> Maybe Schema
forall a. a -> Maybe a
Just (Schema -> Maybe Schema) -> Schema -> Maybe Schema
forall a b. (a -> b) -> a -> b
$ QualifiedIdentifier -> Schema
qiName QualifiedIdentifier
qi
  Single (Composite QualifiedIdentifier
qi) -> Schema -> Maybe Schema
forall a. a -> Maybe a
Just (Schema -> Maybe Schema) -> Schema -> Maybe Schema
forall a b. (a -> b) -> a -> b
$ QualifiedIdentifier -> Schema
qiName QualifiedIdentifier
qi
  RetType
_                     -> Maybe Schema
forall a. Maybe a
Nothing