Add protolude to dependencies, include NoImplicitPrelude in default extensions and port Error module to protolude.

This commit is contained in:
Diogo Biazus
2016-06-29 09:25:57 -04:00
parent 67668a02c2
commit 3308012dcf
4 changed files with 31 additions and 30 deletions
+4 -2
View File
@@ -23,7 +23,7 @@ Flag CI
executable postgrest executable postgrest
main-is: Main.hs main-is: Main.hs
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, NoImplicitPrelude
ghc-options: ghc-options:
-threaded -threaded
-rtsopts -rtsopts
@@ -69,6 +69,7 @@ executable postgrest
, swagger2 >= 2.1 , swagger2 >= 2.1
, HTTP , HTTP
, Ranged-sets , Ranged-sets
, protolude >= 0.1.5 && < 0.2.0
if !os(windows) if !os(windows)
build-depends: unix >= 2.7 && < 3 build-depends: unix >= 2.7 && < 3
@@ -76,7 +77,7 @@ executable postgrest
library library
default-language: Haskell2010 default-language: Haskell2010
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, NoImplicitPrelude
build-depends: aeson build-depends: aeson
, base , base
, bytestring , bytestring
@@ -113,6 +114,7 @@ library
, warp >= 3.1.0 , warp >= 3.1.0
, insert-ordered-containers >= 0.1.0.1 , insert-ordered-containers >= 0.1.0.1
, swagger2 >= 2.1 , swagger2 >= 2.1
, protolude >= 0.1.5 && < 0.2.0
Other-Modules: Paths_postgrest Other-Modules: Paths_postgrest
Exposed-Modules: PostgREST.App Exposed-Modules: PostgREST.App
+3
View File
@@ -1,5 +1,8 @@
module PostgREST.ApiRequest where module PostgREST.ApiRequest where
import Protolude
import qualified GHC.Show as S
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
+20 -24
View File
@@ -4,13 +4,9 @@
module PostgREST.Error (pgErrResponse, errResponse) where module PostgREST.Error (pgErrResponse, errResponse) where
import Protolude
import Data.Aeson ((.=)) import Data.Aeson ((.=))
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.String.Conversions (cs)
import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Hasql.Pool as P import qualified Hasql.Pool as P
import qualified Hasql.Session as H import qualified Hasql.Session as H
@@ -19,7 +15,7 @@ import qualified Network.HTTP.Types.Status as HT
import Network.Wai (Response, responseLBS) import Network.Wai (Response, responseLBS)
errResponse :: HT.Status -> Text -> Response errResponse :: HT.Status -> Text -> Response
errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"]) errResponse status message = responseLBS status [(hContentType, "application/json")] (toS $ T.concat ["{\"message\":\"",message,"\"}"])
pgErrResponse :: Bool -> P.UsageError -> Response pgErrResponse :: Bool -> P.UsageError -> Response
pgErrResponse authed e = pgErrResponse authed e =
@@ -35,41 +31,41 @@ instance JSON.ToJSON P.UsageError where
toJSON (P.ConnectionError e) = JSON.object [ toJSON (P.ConnectionError e) = JSON.object [
"code" .= ("" :: T.Text), "code" .= ("" :: T.Text),
"message" .= ("Connection error" :: T.Text), "message" .= ("Connection error" :: T.Text),
"details" .= (cs (fromMaybe "" e) :: T.Text)] "details" .= (toS $ fromMaybe "" e :: T.Text)]
toJSON (P.SessionError e) = JSON.toJSON e -- H.Error toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
instance JSON.ToJSON H.Error where instance JSON.ToJSON H.Error where
toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [ toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
"code" .= (cs c::T.Text), "code" .= (toS c::T.Text),
"message" .= (cs m::T.Text), "message" .= (toS m::T.Text),
"details" .= (fmap cs d::Maybe T.Text), "details" .= (fmap toS d::Maybe T.Text),
"hint" .= (fmap cs h::Maybe T.Text)] "hint" .= (fmap toS h::Maybe T.Text)]
toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [ toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
"message" .= (cs m::T.Text)] "message" .= (m::T.Text)]
toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [ toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
"message" .= ("Row error: end of input"::String), "message" .= ("Row error: end of input"::T.Text),
"details" .= "details" .=
("Attempt to parse more columns than there are in the result"::String), ("Attempt to parse more columns than there are in the result"::Text),
"details" .= ("Row number " <> show i)] "details" .= (("Row number " <> show i)::Text)]
toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [ toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
"message" .= ("Row error: unexpected null"::String), "message" .= ("Row error: unexpected null"::Text),
"details" .= ("Attempt to parse a NULL as some value."::String), "details" .= ("Attempt to parse a NULL as some value."::Text),
"details" .= ("Row number " <> show i)] "details" .= (("Row number " <> show i)::Text)]
toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [ toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
"message" .= ("Row error: Wrong value parser used"::String), "message" .= ("Row error: Wrong value parser used"::Text),
"details" .= d, "details" .= d,
"details" .= ("Row number " <> show i)] "details" .= (("Row number " <> show i)::Text)]
toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [ toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
"message" .= ("Unexpected amount of rows"::String), "message" .= ("Unexpected amount of rows"::Text),
"details" .= i] "details" .= i]
toJSON (H.ClientError d) = JSON.object [ toJSON (H.ClientError d) = JSON.object [
"message" .= ("Database client error"::String), "message" .= ("Database client error"::Text),
"details" .= (fmap cs d::Maybe T.Text)] "details" .= (fmap toS d::Maybe T.Text)]
httpStatus :: Bool -> P.UsageError -> HT.Status httpStatus :: Bool -> P.UsageError -> HT.Status
httpStatus _ (P.ConnectionError _) = HT.status500 httpStatus _ (P.ConnectionError _) = HT.status500
httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) = httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
case cs c of case toS c of
'0':'8':_ -> HT.status503 -- pg connection err '0':'8':_ -> HT.status503 -- pg connection err
'0':'9':_ -> HT.status500 -- triggered action exception '0':'9':_ -> HT.status500 -- triggered action exception
'0':'L':_ -> HT.status403 -- invalid grantor '0':'L':_ -> HT.status403 -- invalid grantor
+4 -4
View File
@@ -1,9 +1,9 @@
module PostgREST.Types where module PostgREST.Types where
import Protolude
import qualified GHC.Show as S
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.Int (Int32)
import Data.Text
import Data.Tree import Data.Tree
import qualified Data.Vector as V import qualified Data.Vector as V
import PostgREST.RangeQuery (NonnegRange) import PostgREST.RangeQuery (NonnegRange)
@@ -54,12 +54,12 @@ data PrimaryKey = PrimaryKey {
} deriving (Show, Eq) } deriving (Show, Eq)
data OrderDirection = OrderAsc | OrderDesc deriving (Eq) data OrderDirection = OrderAsc | OrderDesc deriving (Eq)
instance Show OrderDirection where instance S.Show OrderDirection where
show OrderAsc = "asc" show OrderAsc = "asc"
show OrderDesc = "desc" show OrderDesc = "desc"
data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq) data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq)
instance Show OrderNulls where instance S.Show OrderNulls where
show OrderNullsFirst = "nulls first" show OrderNullsFirst = "nulls first"
show OrderNullsLast = "nulls last" show OrderNullsLast = "nulls last"