From 3308012dcfa1812bb8e871b38915e52ea92c2e84 Mon Sep 17 00:00:00 2001 From: Diogo Biazus Date: Tue, 28 Jun 2016 15:56:34 -0400 Subject: [PATCH] Add protolude to dependencies, include NoImplicitPrelude in default extensions and port Error module to protolude. --- postgrest.cabal | 6 +++-- src/PostgREST/ApiRequest.hs | 3 +++ src/PostgREST/Error.hs | 44 +++++++++++++++++-------------------- src/PostgREST/Types.hs | 8 +++---- 4 files changed, 31 insertions(+), 30 deletions(-) diff --git a/postgrest.cabal b/postgrest.cabal index 69649b8b0..72b173d1e 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -23,7 +23,7 @@ Flag CI executable postgrest main-is: Main.hs - default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes + default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, NoImplicitPrelude ghc-options: -threaded -rtsopts @@ -69,6 +69,7 @@ executable postgrest , swagger2 >= 2.1 , HTTP , Ranged-sets + , protolude >= 0.1.5 && < 0.2.0 if !os(windows) build-depends: unix >= 2.7 && < 3 @@ -76,7 +77,7 @@ executable postgrest library default-language: Haskell2010 - default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes + default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, NoImplicitPrelude build-depends: aeson , base , bytestring @@ -113,6 +114,7 @@ library , warp >= 3.1.0 , insert-ordered-containers >= 0.1.0.1 , swagger2 >= 2.1 + , protolude >= 0.1.5 && < 0.2.0 Other-Modules: Paths_postgrest Exposed-Modules: PostgREST.App diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 5002454fe..a5a50f7cf 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -1,5 +1,8 @@ module PostgREST.ApiRequest where +import Protolude +import qualified GHC.Show as S + import qualified Data.Aeson as JSON import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index d4bbecc85..5b04cdfa2 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -4,13 +4,9 @@ module PostgREST.Error (pgErrResponse, errResponse) where - +import Protolude import Data.Aeson ((.=)) 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 Hasql.Pool as P import qualified Hasql.Session as H @@ -19,7 +15,7 @@ import qualified Network.HTTP.Types.Status as HT import Network.Wai (Response, responseLBS) 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 authed e = @@ -35,41 +31,41 @@ instance JSON.ToJSON P.UsageError where toJSON (P.ConnectionError e) = JSON.object [ "code" .= ("" :: 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 instance JSON.ToJSON H.Error where toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [ - "code" .= (cs c::T.Text), - "message" .= (cs m::T.Text), - "details" .= (fmap cs d::Maybe T.Text), - "hint" .= (fmap cs h::Maybe T.Text)] + "code" .= (toS c::T.Text), + "message" .= (toS m::T.Text), + "details" .= (fmap toS d::Maybe T.Text), + "hint" .= (fmap toS h::Maybe T.Text)] 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 [ - "message" .= ("Row error: end of input"::String), + "message" .= ("Row error: end of input"::T.Text), "details" .= - ("Attempt to parse more columns than there are in the result"::String), - "details" .= ("Row number " <> show i)] + ("Attempt to parse more columns than there are in the result"::Text), + "details" .= (("Row number " <> show i)::Text)] toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [ - "message" .= ("Row error: unexpected null"::String), - "details" .= ("Attempt to parse a NULL as some value."::String), - "details" .= ("Row number " <> show i)] + "message" .= ("Row error: unexpected null"::Text), + "details" .= ("Attempt to parse a NULL as some value."::Text), + "details" .= (("Row number " <> show i)::Text)] 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" .= ("Row number " <> show i)] + "details" .= (("Row number " <> show i)::Text)] toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [ - "message" .= ("Unexpected amount of rows"::String), + "message" .= ("Unexpected amount of rows"::Text), "details" .= i] toJSON (H.ClientError d) = JSON.object [ - "message" .= ("Database client error"::String), - "details" .= (fmap cs d::Maybe T.Text)] + "message" .= ("Database client error"::Text), + "details" .= (fmap toS d::Maybe T.Text)] httpStatus :: Bool -> P.UsageError -> HT.Status httpStatus _ (P.ConnectionError _) = HT.status500 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':'9':_ -> HT.status500 -- triggered action exception '0':'L':_ -> HT.status403 -- invalid grantor diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index b4a225cae..54b91c40c 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -1,9 +1,9 @@ module PostgREST.Types where +import Protolude +import qualified GHC.Show as S import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL -import Data.Int (Int32) -import Data.Text import Data.Tree import qualified Data.Vector as V import PostgREST.RangeQuery (NonnegRange) @@ -54,12 +54,12 @@ data PrimaryKey = PrimaryKey { } deriving (Show, Eq) data OrderDirection = OrderAsc | OrderDesc deriving (Eq) -instance Show OrderDirection where +instance S.Show OrderDirection where show OrderAsc = "asc" show OrderDesc = "desc" data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq) -instance Show OrderNulls where +instance S.Show OrderNulls where show OrderNullsFirst = "nulls first" show OrderNullsLast = "nulls last"