Merge pull request #35 from haskellari/less-hsc

Less hsc2hs: Convert main module into ordinary Haskell file

Author: phadej

postgresql-libpq.cabal

@@ -67,6 +67,8 @@ library
     Database.PostgreSQL.LibPQ.Compat
     Database.PostgreSQL.LibPQ.Enums
     Database.PostgreSQL.LibPQ.Marshal
+    Database.PostgreSQL.LibPQ.Notify
+    Database.PostgreSQL.LibPQ.Oid
 
   build-depends:
       base        >=4.3     && <4.18

src/Database/PostgreSQL/LibPQ.hsc renamed to src/Database/PostgreSQL/LibPQ.hs

@@ -37,6 +37,7 @@
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE ForeignFunctionInterface   #-}
 {-# LANGUAGE EmptyDataDecls             #-}
 {-# LANGUAGE OverloadedStrings          #-}
@@ -212,10 +213,6 @@ module Database.PostgreSQL.LibPQ
     )
 where
 
-#include <libpq-fe.h>
-#include <libpq/libpq-fs.h>
-#include "noticehandlers.h"
-
 import Prelude hiding ( print )
 import Foreign
 import Foreign.C.Types
@@ -242,12 +239,12 @@ import qualified Data.ByteString as B
 
 import Control.Concurrent.MVar
 
-import Data.Typeable
-
 import Database.PostgreSQL.LibPQ.Compat
 import Database.PostgreSQL.LibPQ.Enums
 import Database.PostgreSQL.LibPQ.Internal
 import Database.PostgreSQL.LibPQ.Marshal
+import Database.PostgreSQL.LibPQ.Notify
+import Database.PostgreSQL.LibPQ.Oid
 
 #if __GLASGOW_HASKELL__ >= 700
 import Control.Exception (mask_)
@@ -699,12 +696,6 @@ connectionUsedPassword connection =
 newtype Result = Result (ForeignPtr PGresult) deriving (Eq, Show)
 data PGresult
 
-
-newtype Oid = Oid CUInt deriving (Eq, Ord, Read, Show, Storable, Typeable)
-
-invalidOid :: Oid
-invalidOid = Oid (#const InvalidOid)
-
 -- | Convert a list of parameters to the format expected by libpq FFI calls.
 withParams :: [Maybe (Oid, B.ByteString, Format)]
            -> (CInt -> Ptr Oid -> Ptr CString -> Ptr CInt -> Ptr CInt -> IO a)
@@ -1739,35 +1730,7 @@ cancel (Cancel fp) =
 -- ordinary SQL commands. The arrival of NOTIFY messages can
 -- subsequently be detected by calling 'notifies'.
 
-data Notify = Notify {
-      notifyRelname :: {-# UNPACK #-} !B.ByteString -- ^ notification channel name
-    , notifyBePid   :: {-# UNPACK #-} !CPid         -- ^ process ID of notifying server process
-    , notifyExtra   :: {-# UNPACK #-} !B.ByteString -- ^ notification payload string
-    } deriving Show
 
-#if __GLASGOW_HASKELL__ < 800
-#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
-#endif
-instance Storable Notify where
-  sizeOf _ = #{size PGnotify}
-
-  alignment _ = #{alignment PGnotify}
-
-  peek ptr = do
-      relname <- B.packCString =<< #{peek PGnotify, relname} ptr
-      extra   <- B.packCString =<< #{peek PGnotify, extra} ptr
-      be_pid  <- fmap f $ #{peek PGnotify, be_pid} ptr
-      return $! Notify relname be_pid extra
-      where
-        f :: CInt -> CPid
-        f = fromIntegral
-
-  poke ptr (Notify a b c) =
-      B.useAsCString a $ \a' ->
-        B.useAsCString c $ \c' ->
-            do #{poke PGnotify, relname} ptr a'
-               #{poke PGnotify, be_pid}  ptr (fromIntegral b :: CInt)
-               #{poke PGnotify, extra}   ptr c'
 
 
 -- | Returns the next notification from a list of unhandled
@@ -1915,8 +1878,6 @@ maybeBsFromForeignPtr fp f =
 
 type NoticeReceiver = NoticeBuffer -> Ptr PGresult -> IO ()
 
-data PGnotice
-
 -- | Upon connection initialization, any notices received from the server are
 --   normally written to the console.  Notices are akin to warnings, and
 --   are distinct from notifications.  This function suppresses notices.
@@ -1954,8 +1915,8 @@ getNotice (Conn _ nbRef) =
         then return Nothing
         else do
           fp <- newForeignPtr finalizerFree (castPtr np)
-          len  <- #{peek PGnotice, len} np
-          return $! Just $! mkPS fp (#offset PGnotice, str) len
+          len  <- pgNoticePeekLen np
+          return $! Just $! mkPS fp pgNoticeOffsetStr (fromIntegral len)
 
 -- $largeobjects
 

src/Database/PostgreSQL/LibPQ/Internal.hs

@@ -14,7 +14,13 @@
 {-# LANGUAGE BangPatterns   #-}
 {-# LANGUAGE EmptyDataDecls #-}
 
-module Database.PostgreSQL.LibPQ.Internal where
+module Database.PostgreSQL.LibPQ.Internal (
+    Connection (..),
+    withConn,
+    PGconn,
+    CNoticeBuffer,
+    NoticeBuffer,
+) where
 
 import Control.Concurrent.MVar (MVar)
 import Foreign

src/Database/PostgreSQL/LibPQ/Notify.hsc

@@ -0,0 +1,56 @@
+module Database.PostgreSQL.LibPQ.Notify where
+
+#include <libpq-fe.h>
+#include "noticehandlers.h"
+
+import Foreign (Ptr, Storable (..))
+import Foreign.C.Types (CInt, CSize)
+import System.Posix.Types (CPid)
+
+import qualified Data.ByteString as B
+
+-------------------------------------------------------------------------------
+-- Notify
+-------------------------------------------------------------------------------
+
+data Notify = Notify {
+      notifyRelname :: {-# UNPACK #-} !B.ByteString -- ^ notification channel name
+    , notifyBePid   :: {-# UNPACK #-} !CPid         -- ^ process ID of notifying server process
+    , notifyExtra   :: {-# UNPACK #-} !B.ByteString -- ^ notification payload string
+    } deriving Show
+
+#if __GLASGOW_HASKELL__ < 800
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+instance Storable Notify where
+  sizeOf _ = #{size PGnotify}
+
+  alignment _ = #{alignment PGnotify}
+
+  peek ptr = do
+      relname <- B.packCString =<< #{peek PGnotify, relname} ptr
+      extra   <- B.packCString =<< #{peek PGnotify, extra} ptr
+      be_pid  <- fmap f $ #{peek PGnotify, be_pid} ptr
+      return $! Notify relname be_pid extra
+      where
+        f :: CInt -> CPid
+        f = fromIntegral
+
+  poke ptr (Notify a b c) =
+      B.useAsCString a $ \a' ->
+        B.useAsCString c $ \c' ->
+            do #{poke PGnotify, relname} ptr a'
+               #{poke PGnotify, be_pid}  ptr (fromIntegral b :: CInt)
+               #{poke PGnotify, extra}   ptr c'
+
+-------------------------------------------------------------------------------
+-- Notice
+-------------------------------------------------------------------------------
+
+data PGnotice
+
+pgNoticePeekLen :: Ptr PGnotice -> IO CSize
+pgNoticePeekLen = #{peek PGnotice, len}
+
+pgNoticeOffsetStr :: Int
+pgNoticeOffsetStr = #{offset PGnotice, str}

src/Database/PostgreSQL/LibPQ/Oid.hsc

@@ -0,0 +1,14 @@
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Database.PostgreSQL.LibPQ.Oid where
+
+#include <libpq-fe.h>
+
+import Data.Typeable (Typeable)
+import Foreign.C.Types (CUInt)
+import Foreign.Storable (Storable)
+
+newtype Oid = Oid CUInt deriving (Eq, Ord, Read, Show, Storable, Typeable)
+
+invalidOid :: Oid
+invalidOid = Oid (#const InvalidOid)