code cleanup

2015-09-25 11:51:37 +03:00
parent 770e04c04a
commit c42832f1c5
12 changed files with 272 additions and 269 deletions
@@ -1,11 +1,15 @@
 {-# LANGUAGE FlexibleContexts #-}
-module PostgREST.App (app, sqlError, isSqlError, contentTypeForAccept
-- added
+module PostgREST.App (
+  app
+, sqlError
+, isSqlError
+, contentTypeForAccept
 , jsonH
 , requestedSchema
 , TableOptions(..)
 ) where

+
 import Control.Monad (join)
 import Control.Arrow ((***), second)
 import Control.Applicative
@@ -53,7 +57,7 @@ import PostgREST.Functions
 import Prelude

 app :: DbStructure -> AppConfig -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
-app dbstructure conf reqBody role req =
+app dbstructure conf reqBody dbrole req =
  case (path, verb) of
    -- ([], _) -> do
    --   body <- encode <$> tables (cs schema)
@@ -67,11 +71,11 @@ app dbstructure conf reqBody role req =
    --     $ encode (TableOptions cols pkey)

    ([], _) -> do
-      let body = encode $ filter (filterTableAcl role) $ filter (((cs schema)==).tableSchema) allTables
+      let body = encode $ filter (filterTableAcl dbrole) $ filter (((cs schema)==).tableSchema) allTables
      return $ responseLBS status200 [jsonH] $ cs body

    ([table], "OPTIONS") -> do
-      let qt = Table schema table
+      --let qt = Table schema table
      let cols = filter (filterCol schema table) allColumns
      let pkeys = map pkName $ filter (filterPk schema table) allPrimaryKeys
      let body = encode (TableOptions cols pkeys)
@@ -218,13 +222,13 @@ app dbstructure conf reqBody role req =
        Right toBeInserted -> do
          rows :: [Identity Text] <- H.listEx $ uncurry (insertInto qt) toBeInserted
          let inserted :: [Object] = mapMaybe (decode . cs . runIdentity) rows
-              primaryKeys = map pkName $ filter (filterPk schema table) allPrimaryKeys
-          --primaryKeys <- primaryKeyColumns qt
+              pKeys = map pkName $ filter (filterPk schema table) allPrimaryKeys
+          --pKeys <- primaryKeyColumns qt
          let responses = flip map inserted $ \obj -> do
                let primaries =
-                      if Prelude.null primaryKeys
+                      if Prelude.null pKeys
                        then obj
-                        else M.filterWithKey (const . (`elem` primaryKeys)) obj
+                        else M.filterWithKey (const . (`elem` pKeys)) obj
                let params = urlEncodeVars
                      $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
                      $ sortBy (comparing fst) $ M.toList primaries
@@ -253,10 +257,10 @@ app dbstructure conf reqBody role req =
    ([table], "PUT") ->
      handleJsonObj reqBody $ \obj -> do
        let qt = qualify table
-            primaryKeys = map pkName $ filter (filterPk schema table) allPrimaryKeys
-        --primaryKeys <- primaryKeyColumns qt
+            pKeys = map pkName $ filter (filterPk schema table) allPrimaryKeys
+        --pKeys <- primaryKeyColumns qt
        let specifiedKeys = map (cs . fst) qq
-        if S.fromList primaryKeys /= S.fromList specifiedKeys
+        if S.fromList pKeys /= S.fromList specifiedKeys
          then return $ responseLBS status405 []
            "You must speficy all and only primary keys as params"
          else do
@@ -317,8 +321,9 @@ app dbstructure conf reqBody role req =
    allColumns = columns dbstructure
    allPrimaryKeys = primaryKeys dbstructure
    --allTablesAcl = tablesAcl dbstructure
-    filterCol schema table (Column{colSchema=s, colTable=t}) =  s==schema && table==t
-    filterPk schema table (PrimaryKey{pkSchema=s, pkTable=t}) =  s==schema && table==t
+    filterCol sc table (Column{colSchema=s, colTable=t}) =  s==sc && table==t
+    filterCol _ _ _ =  False
+    filterPk sc table (PrimaryKey{pkSchema=s, pkTable=t}) =  s==sc && table==t

    filterTableAcl :: Text -> Table -> Bool
    filterTableAcl r (Table{tableAcl=a}) = r `elem` a
@@ -1,27 +1,28 @@
-{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE QuasiQuotes         #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module PostgREST.Auth where

-import Data.Aeson
-import Control.Monad (mzero)
-import Control.Applicative
-import Crypto.BCrypt
-import Data.Text
-import Data.Monoid
-import Data.Map
-import qualified Data.Vector as V
-import qualified Hasql as H
-import qualified Hasql.Backend as B
-import qualified Hasql.Postgres as P
-import qualified Web.JWT as JWT
-import Data.String.Conversions (cs)
-import PostgREST.PgQuery (pgFmtLit)
+import           Control.Applicative
+import           Control.Monad           (mzero)
+import           Crypto.BCrypt
+import           Data.Aeson
+import           Data.Map
+import           Data.Monoid
+import           Data.String.Conversions (cs)
+import           Data.Text
+import qualified Data.Vector             as V
+import qualified Hasql                   as H
+import qualified Hasql.Backend           as B
+import qualified Hasql.Postgres          as P
+import           PostgREST.PgQuery       (pgFmtLit)
+import           Prelude
+import qualified Web.JWT                 as JWT

-import Prelude
-
-import System.IO.Unsafe
+import           System.IO.Unsafe

 data AuthUser = AuthUser {
-    userId :: String
+    userId   :: String
  , userPass :: String
  , userRole :: String
  } deriving (Show)
@@ -1,27 +1,28 @@
 module PostgREST.Config where

-import Network.Wai
-import Control.Applicative
-import Data.Text (strip)
-import qualified Data.CaseInsensitive as CI
-import qualified Data.ByteString.Char8 as BS
-import Data.String.Conversions (cs)
-import Options.Applicative hiding (columns)
-import Network.Wai.Middleware.Cors (CorsResourcePolicy(..))
-import Prelude
+
+import           Control.Applicative
+import qualified Data.ByteString.Char8       as BS
+import qualified Data.CaseInsensitive        as CI
+import           Data.String.Conversions     (cs)
+import           Data.Text                   (strip)
+import           Network.Wai
+import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
+import           Options.Applicative         hiding (columns)
+import           Prelude

 data AppConfig = AppConfig {
-    configDbName :: String
-  , configDbPort :: Int
-  , configDbUser :: String
-  , configDbPass :: String
-  , configDbHost :: String
+    configDbName    :: String
+  , configDbPort    :: Int
+  , configDbUser    :: String
+  , configDbPass    :: String
+  , configDbHost    :: String

-  , configPort  :: Int
-  , configAnonRole :: String
-  , configSecure :: Bool
-  , configPool :: Int
-  , configV1Schema :: String
+  , configPort      :: Int
+  , configAnonRole  :: String
+  , configSecure    :: Bool
+  , configPool      :: Int
+  , configV1Schema  :: String

  , configJwtSecret :: String
  }
@@ -1,18 +1,20 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}

 module PostgREST.Error (PgError, errResponse) where

-import qualified Hasql as H
-import qualified Hasql.Postgres as P
+
+import           Data.Aeson                ((.=))
+import qualified Data.Aeson                as JSON
+import           Data.String.Conversions   (cs)
+import           Data.String.Utils         (replace)
+import qualified Data.Text                 as T
+import qualified Hasql                     as H
+import qualified Hasql.Postgres            as P
+import           Network.HTTP.Types.Header
 import qualified Network.HTTP.Types.Status as HT
-import qualified Data.Aeson as JSON
-import qualified Data.Text as T
-import Data.Aeson ((.=))
-import Data.String.Conversions (cs)
-import Data.String.Utils(replace)
-import Network.Wai(Response, responseLBS)
-import Network.HTTP.Types.Header
+import           Network.Wai               (Response, responseLBS)

 type PgError = H.SessionError P.Postgres

@@ -2,17 +2,20 @@
 module PostgREST.Functions
 where

-import PostgREST.Types
+
 import           Control.Error
-import Data.List (find)
-import Data.Tree
-import Data.Text hiding (find, foldr, map, null, last, head)
-import Data.Monoid
-import PostgREST.PgQuery (orderT, pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, whiteList, QualifiedIdentifier(..), StatementT, PStmt)
-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-import qualified Hasql.Backend as B
-import qualified Data.Vector as V (empty)
+import           Data.List         (find)
+import           Data.Monoid
+import           Data.Text         hiding (find, foldr, head, last, map, null)
+import           Data.Tree
+import           PostgREST.PgQuery (PStmt, QualifiedIdentifier (..), fromQi,
+                                    orderT, pgFmtIdent, pgFmtLit, pgFmtOperator,
+                                    pgFmtValue, whiteList)
+import           PostgREST.Types
+--import qualified Hasql as H
+--import qualified Hasql.Postgres as P
+import qualified Data.Vector       as V (empty)
+import qualified Hasql.Backend     as B



@@ -47,7 +50,7 @@ requestNodeToQuery schema allTables allColumns (RequestNode tblNameS flds fltrs
            where
                -- it's ok not to check that the table exists here, mainTable will do the checking
                toDbSelectItem :: SelectItem -> Either Text DbSelectItem
-                toDbSelectItem (("*", Nothing), Nothing) = Right $ ((Star{colSchema = schema, colTable = tblName}, Nothing), Nothing)
+                toDbSelectItem (("*", Nothing), Nothing) = Right ((Star{colSchema = schema, colTable = tblName}, Nothing), Nothing)
                toDbSelectItem ((c,jp), cast) = (,) <$> dbFld <*> pure cast
                    where
                        col = findColumn allColumns schema tblName $ pack c
@@ -63,7 +66,7 @@ addRelations allRelations parentNode node@(Node query@(Select {qMainTable=table}
        Nothing -> Node query{qRelation=Nothing} <$> updatedForest
        (Just (Node (Select{qMainTable=parentTable}) _)) -> Node <$> (addRel query <$> rel) <*> updatedForest
            where
-                rel = note ("no relation between " <> (tableName table) <> " and " <> (tableName parentTable)) $
+                rel = note ("no relation between " <> tableName table <> " and " <> tableName parentTable) $
                    findRelation allRelations (tableSchema table) (tableName table) (tableName parentTable)
                addRel :: Query -> Relation -> Query
                addRel q r = q{qRelation = Just r}
@@ -85,7 +88,7 @@ addJoinConditions allColumns (Node query@(Select{qRelation=relation}) forest) =
        _ -> Left "unknow relation"
    where
        -- add parentTable and parentJoinConditions to the query
-        updatedQuery = foldr (flip addCond) (query{qJoinTables = parentTables ++ (qJoinTables query)}) <$> parentJoinConditions
+        updatedQuery = foldr (flip addCond) (query{qJoinTables = parentTables ++ qJoinTables query}) <$> parentJoinConditions
            where
                parentJoinConditions = mapM (getJoinCondition.snd) parents
                parentTables = map fst parents
@@ -101,7 +104,7 @@ addJoinConditions allColumns (Node query@(Select{qRelation=relation}) forest) =


 dbRequestToCountQuery :: DbRequest -> PStmt
-dbRequestToCountQuery (Node (Select mainTable _ _ conditions _ _) forest) =
+dbRequestToCountQuery (Node (Select mainTable _ _ conditions _ _) _) =
    B.Stmt query V.empty True
    where
      query = Data.Text.unwords [
@@ -112,8 +115,8 @@ dbRequestToCountQuery (Node (Select mainTable _ _ conditions _ _) forest) =
      emptyOnNull val x = if null x then "" else val

 dbRequestToQuery :: DbRequest -> PStmt
-dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation ord) forest) =
-    orderT (fromMaybe [] ord) $ query
+dbRequestToQuery (Node (Select mainTable colSelects tbls conditions _ ord) forest) =
+    orderT (fromMaybe [] ord)  query
    -- case relation of
    --     Nothing ->B.Stmt ("SELECT "
    --               <> "("
@@ -129,11 +132,11 @@ dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation or
    --     _         -> B.Stmt query V.empty True
    where

-        query = B.Stmt q V.empty True
-        q = Data.Text.unwords [
+        query = B.Stmt qStr V.empty True
+        qStr = Data.Text.unwords [
            ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
-            "SELECT ", intercalate ", " (map selectItemToStr columns ++ selects),
-            "FROM ", intercalate ", " (map pgFmtTable (mainTable:tables)),
+            "SELECT ", intercalate ", " (map selectItemToStr colSelects ++ selects),
+            "FROM ", intercalate ", " (map pgFmtTable (mainTable:tbls)),
            ("WHERE " <> intercalate " AND " ( map pgFmtCondition conditions )) `emptyOnNull` conditions
            ]
        emptyOnNull val x = if null x then "" else val
@@ -186,7 +189,7 @@ pgFmtColumn Column {colSchema=s, colTable=t, colName=c} = pgFmtIdent s <> "." <>
 pgFmtColumn Star {colSchema=s, colTable=t} = pgFmtIdent s <> "." <> pgFmtIdent t <> ".*"

 pgFmtJsonPath :: Maybe JsonPath -> Text
-pgFmtJsonPath (Just [x]) = "->>" <> (pgFmtLit $ pack x)
+pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit (pack x)
 pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit (pack x) <> pgFmtJsonPath ( Just xs )
 pgFmtJsonPath _ = ""

@@ -199,4 +202,4 @@ selectItemToStr ((c, jp), Just cast ) = "CAST (" <> pgFmtColumn c <> pgFmtJsonPa

 asJsonPath :: Maybe JsonPath -> Text
 asJsonPath Nothing = ""
-asJsonPath (Just xx) = " AS " <> (pack $ last xx)
+asJsonPath (Just xx) = " AS " <> pack (last xx)
@@ -1,42 +1,48 @@
-{-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes         #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Main where

-import Paths_postgrest (version)
+
+import           Paths_postgrest                      (version)
 -- added
-import PostgREST.PgStructure
-import Data.Aeson
-import Data.List (find)
-import Data.Maybe (isJust)
-import PostgREST.Types
-import Network.HTTP.Types.Status
-import Network.HTTP.Types.Header
-import Network.Wai -- (strictRequestBody, pathInfo, requestMethod, requestHeaders)
+import           PostgREST.PgStructure
+--import Data.Aeson
+--import Data.List (find)
+--import Data.Maybe (isJust)
+import           PostgREST.Types
+--import Network.HTTP.Types.Status
+--import Network.HTTP.Types.Header
+import           Network.Wai


-import PostgREST.App
-import PostgREST.Middleware
-import PostgREST.Error(errResponse)
+import           PostgREST.App
+import           PostgREST.Error                      (errResponse)
+import           PostgREST.Middleware

-import Control.Monad (unless)
-import Control.Monad.IO.Class (liftIO)
-import Data.String.Conversions (cs)
-import Network.Wai.Handler.Warp hiding (Connection)
-import Network.Wai.Middleware.RequestLogger (logStdout)
-import Data.List (intercalate)
-import Data.Version (versionBranch)
-import Data.Functor.Identity
-import Data.Text(Text)
-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-import Options.Applicative hiding (columns)
+import           Control.Monad                        (unless)
+import           Control.Monad.IO.Class               (liftIO)
+import           Data.Functor.Identity
+import           Data.List                            (intercalate)
+import           Data.String.Conversions              (cs)
+import           Data.Text                            (Text)
+import           Data.Version                         (versionBranch)
+import qualified Hasql                                as H
+import qualified Hasql.Postgres                       as P
+import           Network.Wai.Handler.Warp             hiding (Connection)
+import           Network.Wai.Middleware.RequestLogger (logStdout)
+import           Options.Applicative                  hiding (columns)

-import System.IO (stderr, stdin, stdout, hSetBuffering, BufferMode(..))
+import           System.IO                            (BufferMode (..),
+                                                       hSetBuffering, stderr,
+                                                       stdin, stdout)

-import PostgREST.Config (AppConfig(..), argParser)
+import           PostgREST.Config                     (AppConfig (..),
+                                                       argParser)

+isServerVersionSupported :: H.Session P.Postgres IO Bool
 isServerVersionSupported = do
  Identity (row :: Text) <- H.tx Nothing $ H.singleEx $ [H.stmt|SHOW server_version_num|]
-  return $ read (cs row) >= 90200
+  return $ read (cs row) >= (90200::Integer)

 main :: IO ()
 main = do
@@ -76,12 +82,12 @@ main = do
    H.poolSettings (fromIntegral $ configPool conf) 30
  pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings

-  resOrError <- H.session pool isServerVersionSupported
+  supportedOrError <- H.session pool isServerVersionSupported
  either (fail . show)
    (\supported ->
      unless supported $
        fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0"
-    ) resOrError
+    ) supportedOrError

    -- read the structure of the database
    -- read the structure of the database
@@ -96,7 +102,7 @@ main = do
  colsRes <-  H.session pool $ H.tx txParam $ allcolumns allRelations
  let allColumns = either (fail . show) id colsRes

-  pkRes <-  H.session pool $ H.tx txParam $ allprimaryKeys
+  pkRes <-  H.session pool $ H.tx txParam allprimaryKeys
  let allPrimaryKeys = either (fail . show) id pkRes

  -- tableAclRes <-  H.session pool $ H.tx txParam $ alltablesAcl
@@ -3,32 +3,37 @@

 module PostgREST.Middleware where

-import Data.Maybe (fromMaybe, isNothing)
-import Data.Monoid
-import Data.Text
+import           Data.Maybe                    (fromMaybe, isNothing)
+import           Data.Monoid
+import           Data.Text
 -- import Data.Pool(withResource, Pool)

-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-import Data.String.Conversions(cs)
+import           Data.String.Conversions       (cs)
+import qualified Hasql                         as H
+import qualified Hasql.Postgres                as P

-import Network.HTTP.Types.Header (hLocation, hAuthorization, hAccept)
-import Network.HTTP.Types (RequestHeaders)
-import Network.HTTP.Types.Status (status400, status401, status301, status415)
-import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo,
-                   rawQueryString, isSecure, Request(..), Response)
-import Network.Wai.Middleware.Gzip (gzip, def)
-import Network.Wai.Middleware.Cors (cors)
-import Network.Wai.Middleware.Static (staticPolicy, only)
-import Network.URI (URI(..), parseURI)
+import           Network.HTTP.Types            (RequestHeaders)
+import           Network.HTTP.Types.Header     (hAccept, hAuthorization,
+                                                hLocation)
+import           Network.HTTP.Types.Status     (status301, status400, status401,
+                                                status415)
+import           Network.URI                   (URI (..), parseURI)
+import           Network.Wai                   (Application, Request (..),
+                                                Response, isSecure, rawPathInfo,
+                                                rawQueryString, requestHeaders,
+                                                responseLBS)
+import           Network.Wai.Middleware.Cors   (cors)
+import           Network.Wai.Middleware.Gzip   (def, gzip)
+import           Network.Wai.Middleware.Static (only, staticPolicy)

-import PostgREST.Config (AppConfig(..), corsPolicy)
-import PostgREST.Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, setUserId)
-import PostgREST.App (contentTypeForAccept)
-import Codec.Binary.Base64.String (decode)
-import PostgREST.Auth (DbRole)
+import           Codec.Binary.Base64.String    (decode)
+import           PostgREST.App                 (contentTypeForAccept)
+import           PostgREST.Auth                (DbRole, LoginAttempt (..),
+                                                setRole, setUserId, signInRole,
+                                                signInWithJWT)
+import           PostgREST.Config              (AppConfig (..), corsPolicy)

-import Prelude
+import           Prelude

 authenticated :: forall s. AppConfig ->
                 (DbRole -> Request -> H.Tx P.Postgres s Response) ->
@@ -1,33 +1,18 @@
 --{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings, FlexibleContexts #-}
 module PostgREST.Parsers
-- ( parseGetRequest
-- , pSelect
-- , pField
-- , pRequestSelect
-- )
-
+( parseGetRequest
+)
 where
-import           Text.ParserCombinators.Parsec hiding (many, (<|>))
--import Text.Parsec.Text
--import Text.Parsec hiding (many, (<|>))
--import Text.Parsec.Prim hiding (many, (<|>))
+
 import           Control.Applicative
--import Control.Monad
--import qualified Data.Text                     as T
-import           Data.Tree
-import           Network.Wai                   (Request, pathInfo, queryString)
-import           PostgREST.Types
--import qualified Data.ByteString.Char8 as C
--import           Control.Monad
--import           Data.Foldable                 (foldrM)
+import           Control.Monad                 (join)
 import           Data.List                     (delete, find)
 import           Data.Maybe
 import           Data.String.Conversions       (cs)
-import  Control.Monad (join)
-
--import qualified Data.ByteString.Char8 as C
-
--buildRequest :: String -> String -> [(String, String)] -> Either P.ParseError Request
+import           Data.Tree
+import           Network.Wai                   (Request, pathInfo, queryString)
+import           PostgREST.Types
+import           Text.ParserCombinators.Parsec hiding (many, (<|>))
 parseGetRequest :: Request -> Either ParseError ApiRequest
 parseGetRequest httpRequest =
    foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
@@ -38,7 +23,7 @@ parseGetRequest httpRequest =
        rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
        qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
        orderStr = join $ lookup "order" qString
-        ord = traverse (parse pOrder ("failed to parse order ()")) orderStr
+        ord = traverse (parse pOrder ("failed to parse order ("++fromMaybe "" orderStr++")")) orderStr
        selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to *
        whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]

@@ -81,15 +66,12 @@ addFilter (path, flt) (Node rn forest) =
 ws :: Parser String
 ws = many (oneOf " \t")

--lexeme :: Parser String -> Parser String
--lexeme :: Text.Parsec.Prim.ParsecT String () Data.Functor.Identity.Identity a -> Text.Parsec.Prim.ParsecT String () Data.Functor.Identity.Identity a
--lexeme :: Text.Parsec.Prim.ParsecT String () Data.Functor.Identity.Identity Char -> Text.Parsec.Prim.ParsecT String () Data.Functor.Identity.Identity Char
+lexeme :: Parser a -> Parser a
 lexeme p = ws *> p <* ws

 pTreePath :: Parser (Path,Field)
 pTreePath = do
-    p <- (pFieldName `sepBy1` pDelimiter)
-    --f <- pField
+    p <- pFieldName `sepBy1` pDelimiter
    jp <- optionMaybe ( string "->" >>  pJsonPath)
    return (init p, (last p, jp))

@@ -98,17 +80,8 @@ pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')

 pFieldTree :: Parser (Tree SelectItem)
-pFieldTree =
-    try ( do
-        fld <- pSelect
-        char '('
-        subforest <- pFieldForest
-        char ')'
-        return (Node fld subforest)
-        )
-    <|> do
-        fld <- pSelect
-        return (Node fld [])
+pFieldTree = try (Node <$> pSelect <*> ( char '(' *> pFieldForest <* char ')'))
+          <|>     Node <$> pSelect <*> pure []

 pStar :: Parser String
 pStar = string "*" *> pure "*"
@@ -117,22 +90,18 @@ pFieldName :: Parser String
 pFieldName =  many1 (letter <|> digit <|> oneOf "_")
          <?> "field name (* or [a..z0..9_])"

+pJsonPathDelimiter :: Parser String
+pJsonPathDelimiter = try (string "->>") <|> string "->"
+
 pJsonPath :: Parser [String]
-pJsonPath = pFieldName `sepBy1` (try (string "->>") <|> string "->")
+pJsonPath = pFieldName `sepBy1` pJsonPathDelimiter

 pField :: Parser Field
-pField = lexeme $ do
-    f <- pFieldName
-    jp <- optionMaybe ( (try (string "->>") <|> string "->") >>  pJsonPath)
-    return (f, jp)
+pField = lexeme $ (,) <$> pFieldName <*> optionMaybe ( pJsonPathDelimiter *>  pJsonPath)

 pSelect :: Parser SelectItem
 pSelect = lexeme $
-    try (do
-        n <- pField
-        v <- optionMaybe (string "::" >> many letter)
-        return (n, v)
-        )
+    try ((,) <$> pField <*> optionMaybe (string "::" *> many letter))
    <|> do
        s <- pStar
        return ((s, Nothing), Nothing)
@@ -154,8 +123,8 @@ pOperator =  try (string "lte") -- has to be before lt
         <|> try (string "@@")
         <?> "operator (eq, gt, ...)"

-pInt :: Parser Int
-pInt = try (liftA read (many1 digit)) <?> "integer"
+-- pInt :: Parser Int
+-- pInt = try (liftA read (many1 digit)) <?> "integer"

 --pValue :: Parser Value
 --pValue = (VInt <$> try (pInt <* eof))
@@ -166,20 +135,19 @@ pValue = many anyChar
 pDelimiter :: Parser Char
 pDelimiter = char '.' <?> "delimiter (.)"

-pOpValueExp :: Parser (Operator, FValue)
-pOpValueExp = do
-  o <- ( try ( liftA2 (++) (string "not.")  pOperator) <|> pOperator )
-  pDelimiter
-  v <- pValue
-  return (o, v)
+pOperatiorWithNegation :: Parser Operator
+pOperatiorWithNegation = try ( (++) <$> string "not." <*>  pOperator) <|> pOperator

-pOrder :: Parser ([OrderTerm])
+pOpValueExp :: Parser (Operator, FValue)
+pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue)
+
+pOrder :: Parser [OrderTerm]
 pOrder = lexeme pOrderTerm `sepBy` char ','

 pOrderTerm :: Parser OrderTerm
 pOrderTerm =  do
  c <- pFieldName
-  pDelimiter
+  _ <- pDelimiter
  d <- string "asc" <|> string "desc"
  nls <- optionMaybe (pDelimiter *> ( try(string "nullslast" *> pure ("nulls last"::String)) <|> try(string "nullsfirst" *> pure ("nulls first"::String))))
  return $ OrderTerm (cs c) (cs d) (cs <$> nls)
@@ -1,31 +1,35 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiWayIf #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE MultiWayIf           #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

 module PostgREST.PgQuery where

-import PostgREST.RangeQuery
-import PostgREST.Types (OrderTerm(..))
-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-import qualified Hasql.Backend as B

-import qualified Data.Text as T
-import qualified Data.HashMap.Strict as H
-import Text.Regex.TDFA ( (=~) )
-import qualified Network.HTTP.Types.URI as Net
-import qualified Data.ByteString.Char8 as BS
-import Data.Monoid
-import Data.Vector (empty)
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Functor
-import Control.Monad (join)
-import Data.String.Conversions (cs)
-import qualified Data.Aeson as JSON
-import qualified Data.List as L
-import qualified Data.Vector as V
-import Data.Scientific (isInteger, formatScientific, FPFormat(..))
+import qualified Hasql                   as H
+import qualified Hasql.Backend           as B
+import qualified Hasql.Postgres          as P
+import           PostgREST.RangeQuery
+import           PostgREST.Types         (OrderTerm (..))

-import Prelude
+import           Control.Monad           (join)
+import qualified Data.Aeson              as JSON
+import qualified Data.ByteString.Char8   as BS
+import           Data.Functor
+import qualified Data.HashMap.Strict     as H
+import qualified Data.List               as L
+import           Data.Maybe              (fromMaybe, mapMaybe)
+import           Data.Monoid
+import           Data.Scientific         (FPFormat (..), formatScientific,
+                                          isInteger)
+import           Data.String.Conversions (cs)
+import qualified Data.Text               as T
+import           Data.Vector             (empty)
+import qualified Data.Vector             as V
+import qualified Network.HTTP.Types.URI  as Net
+import           Text.Regex.TDFA         ((=~))
+
+import           Prelude

 type PStmt = H.Stmt P.Postgres
 instance Monoid PStmt where
@@ -1,24 +1,27 @@
-{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
-             MultiParamTypeClasses, ScopedTypeVariables,
-             FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
 module PostgREST.PgStructure where

-import PostgREST.PgQuery (QualifiedIdentifier(..))
-import PostgREST.Types
-import Data.Text (Text, unpack, split)
-import Data.List (find)
-import Data.Aeson
-import Data.Functor.Identity
-import Data.String.Conversions (cs)
-import Data.Maybe (fromMaybe, isJust)
-import Control.Applicative
+import           Data.List             (find)
+import           Data.Text             (Text, split)
+import           PostgREST.PgQuery     ()
+import           PostgREST.Types
+--import Data.Aeson
+import           Data.Functor.Identity
+--import Data.String.Conversions (cs)
+import           Control.Applicative
+import           Data.Maybe            (fromMaybe, isJust)

-import qualified Data.Map as Map
+--import qualified Data.Map as Map

-import qualified Hasql as H
-import qualified Hasql.Postgres as P
+import qualified Hasql                 as H
+import qualified Hasql.Postgres        as P

-import Prelude
+import           Prelude


 doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool
@@ -53,28 +56,6 @@ columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
    parseEnum str = fromMaybe [] $ split (==',') <$> str


-instance ToJSON Column where
-  toJSON c = object [
-      "schema"    .= colSchema c
-    , "name"      .= colName c
-    , "position"  .= colPosition c
-    , "nullable"  .= colNullable c
-    , "type"      .= colType c
-    , "updatable" .= colUpdatable c
-    , "maxLen"    .= colMaxLen c
-    , "precision" .= colPrecision c
-    , "references".= colFK c
-    , "default"   .= colDefault c
-    , "enum"      .= colEnum c ]
-
-instance ToJSON ForeignKey where
-  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
-
-instance ToJSON Table where
-  toJSON v = object [
-      "schema"     .= tableSchema v
-    , "name"       .= tableName v
-    , "insertable" .= tableInsertable v ]
 ------------


@@ -152,7 +133,7 @@ allrelations = do
  return $ foldr (addFlippedRelation.relationFromRow) [] rels

 allcolumns :: [Relation] -> H.Tx P.Postgres s [Column]
-allcolumns relations = do
+allcolumns rels = do
  cols <- H.listEx $ [H.stmt|
      SELECT
          info.table_schema AS schema,
@@ -197,9 +178,11 @@ allcolumns relations = do
  return $ map (addFK . columnFromRow) cols

  where
-    addFK col = col { colFK = relToFk <$> find (lookupFn col) relations }
+    addFK col = col { colFK = relToFk <$> find (lookupFn col) rels }
+    lookupFn :: Column -> Relation -> Bool
    lookupFn (Column{colSchema=cs, colTable=ct, colName=cn})  (Relation{relSchema=rs, relTable=rt, relColumn=rc, relType=rty}) =
      cs==rs && ct==rt && cn==rc && rty=="child"
+    lookupFn _ _ = False
    relToFk (Relation{relFTable=t, relFColumn=c}) = ForeignKey t c

 allprimaryKeys :: H.Tx P.Postgres s [PrimaryKey]
@@ -6,22 +6,22 @@ module PostgREST.RangeQuery (
 , NonnegRange
 ) where

-import PostgREST.Types (OrderTerm(..))
-import Control.Applicative
-import Network.HTTP.Types.Header

-import qualified Data.ByteString.Char8 as BS
+import           Control.Applicative
+import           Network.HTTP.Types.Header
+import           PostgREST.Types           ()

-import Data.Ranged.Boundaries
-import Data.Ranged.Ranges
+import qualified Data.ByteString.Char8     as BS
+import           Data.Ranged.Boundaries
+import           Data.Ranged.Ranges

-import Data.String.Conversions (cs)
-import Text.Regex.TDFA ((=~))
-import Text.Read (readMaybe)
+import           Data.String.Conversions   (cs)
+import           Text.Read                 (readMaybe)
+import           Text.Regex.TDFA           ((=~))

-import Data.Maybe (fromMaybe, listToMaybe)
+import           Data.Maybe                (fromMaybe, listToMaybe)

-import Prelude
+import           Prelude

 type NonnegRange = Range Int

@@ -2,6 +2,7 @@ module PostgREST.Types where
 import Data.Text
 import Data.Tree
 import qualified Data.ByteString.Char8 as BS
+import Data.Aeson

 data DbStructure = DbStructure {
  tables :: [Table]
@@ -11,6 +12,7 @@ data DbStructure = DbStructure {
 --, tablesAcl :: [(Text, Text, Text)]
 }

+
 data Table = Table {
  tableSchema :: Text
 , tableName :: Text
@@ -92,3 +94,26 @@ data Query = Select {
 , qOrder::Maybe [OrderTerm]
 } deriving (Show)
 type DbRequest = Tree Query
+
+instance ToJSON Column where
+  toJSON c = object [
+      "schema"    .= colSchema c
+    , "name"      .= colName c
+    , "position"  .= colPosition c
+    , "nullable"  .= colNullable c
+    , "type"      .= colType c
+    , "updatable" .= colUpdatable c
+    , "maxLen"    .= colMaxLen c
+    , "precision" .= colPrecision c
+    , "references".= colFK c
+    , "default"   .= colDefault c
+    , "enum"      .= colEnum c ]
+
+instance ToJSON ForeignKey where
+  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
+
+instance ToJSON Table where
+  toJSON v = object [
+      "schema"     .= tableSchema v
+    , "name"       .= tableName v
+    , "insertable" .= tableInsertable v ]