Change some import statements and Session types

This commit is contained in:
Joe Nelson
2016-01-24 18:09:18 -08:00
parent d6102cc908
commit 72cd6c37bd
3 changed files with 13 additions and 19 deletions
+1 -3
View File
@@ -33,9 +33,7 @@ import Data.Aeson
import Data.Aeson.Types (emptyArray) import Data.Aeson.Types (emptyArray)
import Data.Monoid import Data.Monoid
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Hasql as H import qualified Hasql.Connection as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.Parsers import PostgREST.Parsers
+9 -11
View File
@@ -17,15 +17,13 @@ import Data.List (elemIndex, find, subsequences, sort, tr
import Data.Maybe (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe) import Data.Maybe (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe)
import Data.Monoid import Data.Monoid
import Data.Text (Text, split) import Data.Text (Text, split)
import qualified Hasql as H import qualified Hasql.Session as H
import qualified Hasql.Postgres as P
import qualified Hasql.Backend as B
import PostgREST.Types import PostgREST.Types
import GHC.Exts (groupWith) import GHC.Exts (groupWith)
import Prelude import Prelude
getDbStructure :: Schema -> H.Tx P.Postgres s DbStructure getDbStructure :: Schema -> H.Session DbStructure
getDbStructure schema = do getDbStructure schema = do
tabs <- allTables tabs <- allTables
cols <- allColumns tabs cols <- allColumns tabs
@@ -50,7 +48,7 @@ doesProc stmt qi = do
row :: Maybe (Identity Int) <- H.maybeEx $ stmt (qiSchema qi) (qiName qi) row :: Maybe (Identity Int) <- H.maybeEx $ stmt (qiSchema qi) (qiName qi)
return $ isJust row return $ isJust row
doesProcExist :: QualifiedIdentifier -> H.Tx P.Postgres s Bool doesProcExist :: QualifiedIdentifier -> H.Session Bool
doesProcExist = doesProc [H.stmt| doesProcExist = doesProc [H.stmt|
SELECT 1 SELECT 1
FROM pg_catalog.pg_namespace n FROM pg_catalog.pg_namespace n
@@ -60,7 +58,7 @@ doesProcExist = doesProc [H.stmt|
AND proname = ? AND proname = ?
|] |]
doesProcReturnJWT :: QualifiedIdentifier -> H.Tx P.Postgres s Bool doesProcReturnJWT :: QualifiedIdentifier -> H.Session Bool
doesProcReturnJWT = doesProc [H.stmt| doesProcReturnJWT = doesProc [H.stmt|
SELECT 1 SELECT 1
FROM pg_catalog.pg_namespace n FROM pg_catalog.pg_namespace n
@@ -171,7 +169,7 @@ synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys s
keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns
newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns
allTables :: H.Tx P.Postgres s [Table] allTables :: H.Session [Table]
allTables = do allTables = do
rows <- H.listEx $ [H.stmt| rows <- H.listEx $ [H.stmt|
SELECT SELECT
@@ -196,7 +194,7 @@ allTables = do
tableFromRow :: (Text, Text, Bool) -> Table tableFromRow :: (Text, Text, Bool) -> Table
tableFromRow (s, n, i) = Table s n i tableFromRow (s, n, i) = Table s n i
allColumns :: [Table] -> H.Tx P.Postgres s [Column] allColumns :: [Table] -> H.Session [Column]
allColumns tabs = do allColumns tabs = do
cols <- H.listEx $ [H.stmt| cols <- H.listEx $ [H.stmt|
SELECT DISTINCT SELECT DISTINCT
@@ -347,7 +345,7 @@ columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> tab
parseEnum :: Maybe Text -> [Text] parseEnum :: Maybe Text -> [Text]
parseEnum str = fromMaybe [] $ split (==',') <$> str parseEnum str = fromMaybe [] $ split (==',') <$> str
allRelations :: [Table] -> [Column] -> H.Tx P.Postgres s [Relation] allRelations :: [Table] -> [Column] -> H.Session [Relation]
allRelations tabs cols = do allRelations tabs cols = do
rels <- H.listEx $ [H.stmt| rels <- H.listEx $ [H.stmt|
SELECT ns1.nspname AS table_schema, SELECT ns1.nspname AS table_schema,
@@ -388,7 +386,7 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
cols = mapM (findCol rs rt) rcs cols = mapM (findCol rs rt) rcs
colsF = mapM (findCol frs frt) frcs colsF = mapM (findCol frs frt) frcs
allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey] allPrimaryKeys :: [Table] -> H.Session [PrimaryKey]
allPrimaryKeys tabs = do allPrimaryKeys tabs = do
pks <- H.listEx $ [H.stmt| pks <- H.listEx $ [H.stmt|
/* /*
@@ -498,7 +496,7 @@ pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)] allSynonyms :: [Column] -> H.Session [(Column,Column)]
allSynonyms allCols = do allSynonyms allCols = do
syns <- H.listEx $ [H.stmt| syns <- H.listEx $ [H.stmt|
WITH synonyms AS ( WITH synonyms AS (
+3 -5
View File
@@ -7,8 +7,7 @@ import Data.Maybe (fromMaybe)
import Data.Text import Data.Text
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Time.Clock (NominalDiffTime) import Data.Time.Clock (NominalDiffTime)
import qualified Hasql as H import qualified Hasql.Session as H
import qualified Hasql.Postgres as P
import Network.HTTP.Types.Header (hAccept, hAuthorization) import Network.HTTP.Types.Header (hAccept, hAuthorization)
import Network.HTTP.Types.Status (status415, status400) import Network.HTTP.Types.Status (status415, status400)
@@ -26,12 +25,11 @@ import PostgREST.Error (errResponse)
import Prelude hiding(concat) import Prelude hiding(concat)
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Hasql.Backend as B
import qualified Data.Map.Lazy as M import qualified Data.Map.Lazy as M
runWithClaims :: forall s. AppConfig -> NominalDiffTime -> runWithClaims :: forall s. AppConfig -> NominalDiffTime ->
(Request -> H.Tx P.Postgres s Response) -> (Request -> H.Session Response) ->
Request -> H.Tx P.Postgres s Response Request -> H.Session Response
runWithClaims conf time app req = do runWithClaims conf time app req = do
_ <- H.unitEx $ stmt setAnon _ <- H.unitEx $ stmt setAnon
case split (== ' ') (cs auth) of case split (== ' ') (cs auth) of