diff --git a/Setup.hs b/Setup.hs index c103c01..a800e78 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,17 +1,17 @@ -- The code is mostly ripped from -- https://github.com/ekmett/lens/blob/697582fb9a980f273dbf8496253c5bbefedd0a8b/Setup.lhs -import Data.List ( nub ) -import Data.Version ( showVersion ) -import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName ) -import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) -import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) -import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles ) -import Distribution.Simple.BuildPaths ( autogenModulesDir ) -import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref)) -import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) -import Distribution.Text ( display ) -import Distribution.Verbosity ( Verbosity, normal ) -import System.FilePath ( () ) +import Data.List (nub) +import Data.Version (showVersion) +import Distribution.Package (PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName) +import Distribution.PackageDescription (PackageDescription(), TestSuite(..)) +import Distribution.Simple (defaultMainWithHooks, UserHooks(..), simpleUserHooks) +import Distribution.Simple.Utils (rewriteFile, createDirectoryIfMissingVerbose, copyFiles) +import Distribution.Simple.BuildPaths (autogenModulesDir) +import Distribution.Simple.Setup (BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref)) +import Distribution.Simple.LocalBuildInfo (withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps)) +import Distribution.Text (display) +import Distribution.Verbosity (Verbosity, normal) +import System.FilePath (()) main :: IO () main = defaultMainWithHooks simpleUserHooks diff --git a/demo/Main.hs b/demo/Main.hs index 2202a98..d036a3d 100644 --- a/demo/Main.hs +++ b/demo/Main.hs @@ -42,9 +42,9 @@ main = data Account = Account { - email :: Text , - password :: ByteString , - firstName :: Text , + email :: Text, + password :: ByteString, + firstName :: Text, lastName :: Text } @@ -103,7 +103,7 @@ accountDeserializer :: D.Row Account accountDeserializer = liftM4 Account (D.value def) (D.value def) (D.value def) (D.value def) -identifiedDeserializer :: D.Row a -> D.Row ( Int64 , a ) +identifiedDeserializer :: D.Row a -> D.Row (Int64, a) identifiedDeserializer aDeserializer = liftM2 (,) idDeserializer aDeserializer diff --git a/library/Hasql/Commands.hs b/library/Hasql/Commands.hs index 6bba49a..a73e44c 100644 --- a/library/Hasql/Commands.hs +++ b/library/Hasql/Commands.hs @@ -15,8 +15,8 @@ import qualified Data.ByteString.Lazy as BL newtype Commands = - Commands ( DList BB.Builder ) - deriving ( Monoid ) + Commands (DList BB.Builder) + deriving (Monoid) asBytes :: Commands -> ByteString asBytes (Commands list) = diff --git a/library/Hasql/Connection.hs b/library/Hasql/Connection.hs index 0d6c167..5ee4720 100644 --- a/library/Hasql/Connection.hs +++ b/library/Hasql/Connection.hs @@ -35,9 +35,9 @@ data ResultsError = -- An error on the client-side, -- with a message generated by the \"libpq\" library. -- Usually indicates problems with connection. - ClientError !( Maybe ByteString ) | + ClientError !(Maybe ByteString) | ResultError !ResultError - deriving ( Show ) + deriving (Show) data ResultError = -- | @@ -57,7 +57,7 @@ data ResultError = -- * Hint: an optional suggestion what to do about the problem. -- This is intended to differ from detail in that it offers advice (potentially inappropriate) -- rather than hard facts. Might run to multiple lines. - ServerError !ByteString !ByteString !( Maybe ByteString ) !( Maybe ByteString ) | + ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) | -- | -- The database returned an unexpected result. -- Indicates an improper statement or a schema mismatch. @@ -68,26 +68,26 @@ data ResultError = -- | -- An unexpected amount of rows. UnexpectedAmountOfRows !Int - deriving ( Show ) + deriving (Show) data RowError = EndOfInput | UnexpectedNull | ValueError !Text - deriving ( Show ) + deriving (Show) -- | -- A connection acquistion error. data AcquisitionError = -- | Some errors during connection. - BadConnectionStatus !( Maybe ByteString ) | + BadConnectionStatus !(Maybe ByteString) | -- | The server is running a too old version of Postgres. UnsupportedVersion !Int - deriving ( Show ) + deriving (Show) -- | -- Acquire a connection using the provided settings. -acquire :: Settings.Settings -> IO ( Either AcquisitionError Connection ) +acquire :: Settings.Settings -> IO (Either AcquisitionError Connection) acquire settings = runEitherT $ do pqConnection <- lift (IO.acquireConnection settings) @@ -106,7 +106,7 @@ release (Connection pqConnection _ _) = -- | -- Execute a query, producing either a deserialization failure or a successful result. -executeParametricQuery :: Connection -> Query.ParametricQuery a b -> a -> IO ( Either ResultsError b ) +executeParametricQuery :: Connection -> Query.ParametricQuery a b -> a -> IO (Either ResultsError b) executeParametricQuery (Connection pqConnection integerDatetimes registry) (template, serializer, deserializer, preparable) params = fmap (mapLeft coerceResultsError) $ runEitherT $ do EitherT $ IO.sendParametricQuery pqConnection integerDatetimes registry template (coerceSerializer serializer) preparable params diff --git a/library/Hasql/Deserialization.hs b/library/Hasql/Deserialization.hs index a3de489..4be5c64 100644 --- a/library/Hasql/Deserialization.hs +++ b/library/Hasql/Deserialization.hs @@ -221,7 +221,7 @@ rowsVector (Row row) = -- Zero or more rows packed into the list. -- {-# INLINABLE rowsList #-} -rowsList :: Row a -> Result [ a ] +rowsList :: Row a -> Result [a] rowsList (Row row) = Result (Result.foldr (:) [] row) diff --git a/library/Hasql/Deserialization/Result.hs b/library/Hasql/Deserialization/Result.hs index aa025d0..bce5b16 100644 --- a/library/Hasql/Deserialization/Result.hs +++ b/library/Hasql/Deserialization/Result.hs @@ -9,8 +9,8 @@ import qualified Hasql.Prelude as Prelude newtype Result a = - Result ( ReaderT ( Bool , LibPQ.Result ) ( EitherT Error IO ) a ) - deriving ( Functor , Applicative , Monad ) + Result (ReaderT (Bool, LibPQ.Result) (EitherT Error IO) a) + deriving (Functor, Applicative, Monad) data Error = -- | @@ -30,7 +30,7 @@ data Error = -- * Hint: an optional suggestion what to do about the problem. -- This is intended to differ from detail in that it offers advice (potentially inappropriate) -- rather than hard facts. Might run to multiple lines. - ServerError !ByteString !ByteString !( Maybe ByteString ) !( Maybe ByteString ) | + ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) | -- | -- The database returned an unexpected result. -- Indicates an improper statement or a schema mismatch. @@ -41,9 +41,9 @@ data Error = -- | -- An unexpected amount of rows. UnexpectedAmountOfRows !Int - deriving ( Show ) + deriving (Show) -run :: Result a -> ( Bool , LibPQ.Result ) -> IO ( Either Error a ) +run :: Result a -> (Bool, LibPQ.Result) -> IO (Either Error a) run (Result reader) env = runEitherT (runReaderT reader env) @@ -76,7 +76,7 @@ rowsAffected = mapLeft (\m -> UnexpectedResult ("Decimal parsing failure: " <> fromString m)) $ Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) bytes -checkExecStatus :: ( LibPQ.ExecStatus -> Bool ) -> Result () +checkExecStatus :: (LibPQ.ExecStatus -> Bool) -> Result () checkExecStatus predicate = do status <- Result $ ReaderT $ \(_, result) -> lift $ LibPQ.resultStatus result @@ -102,7 +102,7 @@ serverError = LibPQ.resultErrorField result LibPQ.DiagMessageHint pure $ Left $ ServerError code message detail hint -maybe :: Row.Row a -> Result ( Maybe a ) +maybe :: Row.Row a -> Result (Maybe a) maybe rowDes = do checkExecStatus $ \case @@ -141,7 +141,7 @@ single rowDes = intToRow = LibPQ.Row . fromIntegral -generate :: ( forall m. Monad m => Int -> ( Int -> m a ) -> m b ) -> Row.Row a -> Result b +generate :: (forall m. Monad m => Int -> (Int -> m a) -> m b) -> Row.Row a -> Result b generate generateM rowDes = do checkExecStatus $ \case @@ -159,7 +159,7 @@ generate generateM rowDes = intToRow = LibPQ.Row . fromIntegral -foldl :: ( a -> b -> a ) -> a -> Row.Row b -> Result a +foldl :: (a -> b -> a) -> a -> Row.Row b -> Result a foldl step init rowDes = do checkExecStatus $ \case @@ -181,7 +181,7 @@ foldl step init rowDes = intToRow = LibPQ.Row . fromIntegral -foldr :: ( b -> a -> a ) -> a -> Row.Row b -> Result a +foldr :: (b -> a -> a) -> a -> Row.Row b -> Result a foldr step init rowDes = do checkExecStatus $ \case diff --git a/library/Hasql/Deserialization/Results.hs b/library/Hasql/Deserialization/Results.hs index ded61e8..ae53571 100644 --- a/library/Hasql/Deserialization/Results.hs +++ b/library/Hasql/Deserialization/Results.hs @@ -19,8 +19,8 @@ import qualified Hasql.Deserialization.Row as Row newtype Results a = - Results ( ReaderT ( Bool , LibPQ.Connection ) ( EitherT Error IO ) a ) - deriving ( Functor , Applicative , Monad ) + Results (ReaderT (Bool, LibPQ.Connection) (EitherT Error IO) a) + deriving (Functor, Applicative, Monad) data Error = -- | @@ -31,7 +31,7 @@ data Error = ResultError !Result.Error {-# INLINE run #-} -run :: Results a -> ( Bool , LibPQ.Connection ) -> IO ( Either Error a ) +run :: Results a -> (Bool, LibPQ.Connection) -> IO (Either Error a) run (Results stack) env = runEitherT (runReaderT stack env) @@ -67,7 +67,7 @@ getResult = -- | -- Fetch a single result. {-# INLINABLE getResultMaybe #-} -getResultMaybe :: Results ( Maybe LibPQ.Result ) +getResultMaybe :: Results (Maybe LibPQ.Result) getResultMaybe = Results $ ReaderT $ \(_, connection) -> lift $ LibPQ.getResult connection diff --git a/library/Hasql/IO.hs b/library/Hasql/IO.hs index 6d78fbe..b32bfab 100644 --- a/library/Hasql/IO.hs +++ b/library/Hasql/IO.hs @@ -59,7 +59,7 @@ initConnection c = void $ LibPQ.exec c (Commands.asBytes (Commands.setEncodingToUTF8 <> Commands.setMinClientMessagesToWarning)) {-# INLINE getResults #-} -getResults :: LibPQ.Connection -> Bool -> ResultsDeserialization.Results a -> IO ( Either ResultsDeserialization.Error a ) +getResults :: LibPQ.Connection -> Bool -> ResultsDeserialization.Results a -> IO (Either ResultsDeserialization.Error a) getResults connection integerDatetimes des = do result <- ResultsDeserialization.run des (integerDatetimes, connection) @@ -69,8 +69,8 @@ getResults connection integerDatetimes des = {-# INLINABLE getPreparedStatementKey #-} getPreparedStatementKey :: LibPQ.Connection -> PreparedStatementRegistry.PreparedStatementRegistry -> - ByteString -> [ LibPQ.Oid ] -> - IO ( Either ResultsDeserialization.Error ByteString ) + ByteString -> [LibPQ.Oid] -> + IO (Either ResultsDeserialization.Error ByteString) getPreparedStatementKey connection registry template oidList = do keyMaybe <- PreparedStatementRegistry.lookup template wordOIDList registry @@ -93,7 +93,7 @@ getPreparedStatementKey connection registry template oidList = map (\(LibPQ.Oid x) -> fromIntegral x) oidList {-# INLINABLE checkedSend #-} -checkedSend :: LibPQ.Connection -> IO Bool -> IO ( Either ResultsDeserialization.Error () ) +checkedSend :: LibPQ.Connection -> IO Bool -> IO (Either ResultsDeserialization.Error ()) checkedSend connection send = send >>= \case False -> fmap (Left . ResultsDeserialization.ClientError) $ LibPQ.errorMessage connection @@ -104,9 +104,9 @@ sendPreparedParametricQuery :: LibPQ.Connection -> PreparedStatementRegistry.PreparedStatementRegistry -> ByteString -> - [ LibPQ.Oid ] -> - [ Maybe ( ByteString , LibPQ.Format ) ] -> - IO ( Either ResultsDeserialization.Error () ) + [LibPQ.Oid] -> + [Maybe (ByteString, LibPQ.Format)] -> + IO (Either ResultsDeserialization.Error ()) sendPreparedParametricQuery connection registry template oidList valueAndFormatList = runEitherT $ do key <- EitherT $ getPreparedStatementKey connection registry template oidList @@ -116,8 +116,8 @@ sendPreparedParametricQuery connection registry template oidList valueAndFormatL sendUnpreparedParametricQuery :: LibPQ.Connection -> ByteString -> - [ Maybe ( LibPQ.Oid , ByteString , LibPQ.Format ) ] -> - IO ( Either ResultsDeserialization.Error () ) + [Maybe (LibPQ.Oid, ByteString, LibPQ.Format)] -> + IO (Either ResultsDeserialization.Error ()) sendUnpreparedParametricQuery connection template paramList = checkedSend connection $ LibPQ.sendQueryParams connection template paramList LibPQ.Binary @@ -130,7 +130,7 @@ sendParametricQuery :: ParamsSerialization.Params a -> Bool -> a -> - IO ( Either ResultsDeserialization.Error () ) + IO (Either ResultsDeserialization.Error ()) sendParametricQuery connection integerDatetimes registry template serializer prepared params = if prepared then diff --git a/library/Hasql/Prelude.hs b/library/Hasql/Prelude.hs index 0b07845..095b639 100644 --- a/library/Hasql/Prelude.hs +++ b/library/Hasql/Prelude.hs @@ -1,5 +1,5 @@ module Hasql.Prelude -( +( module Exports, LazyByteString, ByteStringBuilder,