Skip to content

Remove protolude since the library seems a bit stale #104

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Apr 21, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions Setup.hs
Original file line number Diff line number Diff line change
@@ -1,2 +1,3 @@
import Distribution.Simple

main = defaultMain
14 changes: 7 additions & 7 deletions app/Main.hs
Original file line number Diff line number Diff line change
@@ -1,19 +1,19 @@
module Main where

import Protolude
import APrelude
import PostgresWebsockets

import System.IO (BufferMode (..), hSetBuffering)

main :: IO ()
main = do
hSetBuffering stdout LineBuffering
hSetBuffering stdin LineBuffering
hSetBuffering stdin LineBuffering
hSetBuffering stderr NoBuffering

putStrLn $ ("postgres-websockets " :: Text)
<> prettyVersion
<> " / Connects websockets to PostgreSQL asynchronous notifications."
putStrLn $
"postgres-websockets "
<> unpack prettyVersion
<> " / Connects websockets to PostgreSQL asynchronous notifications."

conf <- loadConfig
void $ serve conf
void $ serve conf
8 changes: 4 additions & 4 deletions postgres-websockets.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ common warnings

common language
default-language: Haskell2010
default-extensions: OverloadedStrings, NoImplicitPrelude, LambdaCase, RecordWildCards, QuasiQuotes
default-extensions: OverloadedStrings, LambdaCase, RecordWildCards, QuasiQuotes

library
import: warnings
Expand All @@ -29,6 +29,7 @@ library
, PostgresWebsockets.HasqlBroadcast
, PostgresWebsockets.Claims
, PostgresWebsockets.Config
, APrelude

autogen-modules: Paths_postgres_websockets
other-modules: Paths_postgres_websockets
Expand All @@ -49,8 +50,9 @@ library
, http-types >= 0.12.3 && < 0.13
, jose >= 0.11 && < 0.12
, lens >= 5.2.3 && < 5.4
, mtl >=2.3.1 && <2.4
, async >=2.2.5 && <2.3
, postgresql-libpq >= 0.10.0 && < 0.12
, protolude >= 0.2.3 && < 0.4
, retry >= 0.8.1.0 && < 0.10
, stm >= 2.5.0.0 && < 2.6
, stm-containers >= 1.1.0.2 && < 1.3
Expand All @@ -76,7 +78,6 @@ executable postgres-websockets
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base >= 4.7 && < 5
, postgres-websockets
, protolude >= 0.2.3 && < 0.4
default-language: Haskell2010

test-suite postgres-websockets-test
Expand All @@ -90,7 +91,6 @@ test-suite postgres-websockets-test
, HasqlBroadcastSpec
, ServerSpec
build-depends: base
, protolude >= 0.2.3 && < 0.4
, postgres-websockets
, hspec >= 2.7.1 && < 2.12
, aeson >= 2.0 && < 2.3
Expand Down
104 changes: 104 additions & 0 deletions src/APrelude.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,104 @@
module APrelude
( Text,
ByteString,
LByteString,
Generic,
fromMaybe,
putErrLn,
fromRight,
isJust,
decodeUtf8,
encodeUtf8,
MVar,
readMVar,
swapMVar,
newMVar,
STM,
atomically,
ThreadId,
forkFinally,
forkIO,
killThread,
threadDelay,
(>=>),
when,
forever,
void,
panic,
SomeException,
throwError,
liftIO,
runExceptT,
unpack,
pack,
showText,
showBS,
LBS.fromStrict,
stdin,
stdout,
stderr,
hPutStrLn,
Word16,
forM,
forM_,
takeMVar,
newEmptyMVar,
wait,
headDef,
tailSafe,
withAsync,
putMVar,
die,
myThreadId,
replicateM,
bracket,
)
where

import Control.Concurrent (ThreadId, forkFinally, forkIO, killThread, myThreadId, threadDelay)
import Control.Concurrent.Async (wait, withAsync)
import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, swapMVar, takeMVar)
import Control.Concurrent.STM (STM, atomically)
import Control.Exception (Exception, SomeException, bracket, throw)
import Control.Monad (forM, forM_, forever, replicateM, void, when, (>=>))
import Control.Monad.Error.Class (throwError)
import Control.Monad.Except (runExceptT)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Either (fromRight)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Word (Word16)
import GHC.Generics (Generic)
import System.Exit (die)
import System.IO (hPutStrLn, stderr, stdin, stdout)

showBS :: (Show a) => a -> BS.ByteString
showBS = BS.pack . show

showText :: (Show a) => a -> Text
showText = T.pack . show

type LByteString = LBS.ByteString

-- | Uncatchable exceptions thrown and never caught.
newtype FatalError = FatalError {fatalErrorMessage :: Text}
deriving (Show)

instance Exception FatalError

panic :: Text -> a
panic a = throw (FatalError a)

putErrLn :: Text -> IO ()
putErrLn = hPutStrLn stderr . unpack

headDef :: a -> [a] -> a
headDef def = fromMaybe def . listToMaybe

tailSafe :: [a] -> [a]
tailSafe = drop 1
28 changes: 14 additions & 14 deletions src/PostgresWebsockets.hs
Original file line number Diff line number Diff line change
@@ -1,16 +1,16 @@
{-|
Module : PostgresWebsockets
Description : PostgresWebsockets main library interface.

These are all function necessary to configure and start the server.
-}
-- |
-- Module : PostgresWebsockets
-- Description : PostgresWebsockets main library interface.
--
-- These are all function necessary to configure and start the server.
module PostgresWebsockets
( prettyVersion
, loadConfig
, serve
, postgresWsMiddleware
) where
( prettyVersion,
loadConfig,
serve,
postgresWsMiddleware,
)
where

import PostgresWebsockets.Middleware ( postgresWsMiddleware )
import PostgresWebsockets.Server ( serve )
import PostgresWebsockets.Config ( prettyVersion, loadConfig )
import PostgresWebsockets.Config (loadConfig, prettyVersion)
import PostgresWebsockets.Middleware (postgresWsMiddleware)
import PostgresWebsockets.Server (serve)
9 changes: 4 additions & 5 deletions src/PostgresWebsockets/Broadcast.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,11 +26,10 @@ module PostgresWebsockets.Broadcast
)
where

import APrelude
import Control.Concurrent.STM.TChan
import Control.Concurrent.STM.TQueue
import qualified Data.Aeson as A
import Protolude hiding (toS)
import Protolude.Conv (toS)
import qualified StmContainers.Map as M

data Message = Message
Expand Down Expand Up @@ -63,7 +62,7 @@ instance A.ToJSON MultiplexerSnapshot
-- | Given a multiplexer derive a type that can be printed for debugging or logging purposes
takeSnapshot :: Multiplexer -> IO MultiplexerSnapshot
takeSnapshot multi =
MultiplexerSnapshot <$> size <*> e <*> thread
MultiplexerSnapshot <$> size <*> e <*> (pack <$> thread)
where
size = atomically $ M.size $ channels multi
thread = show <$> readMVar (producerThreadId multi)
Expand Down Expand Up @@ -113,7 +112,7 @@ superviseMultiplexer multi msInterval shouldRestart = do
new <- reopenProducer multi
void $ swapMVar (producerThreadId multi) new
snapAfter <- takeSnapshot multi
putStrLn $
print $
"Restarting producer. Multiplexer updated: "
<> A.encode snapBefore
<> " -> "
Expand Down Expand Up @@ -142,7 +141,7 @@ onMessage multi chan action = do
where
disposeListener _ = atomically $ do
mC <- M.lookup chan (channels multi)
let c = fromMaybe (panic $ "trying to remove listener from non existing channel: " <> toS chan) mC
let c = fromMaybe (panic $ "trying to remove listener from non existing channel: " <> chan) mC
M.delete chan (channels multi)
when (listeners c - 1 > 0) $
M.insert Channel {broadcast = broadcast c, listeners = listeners c - 1} chan (channels multi)
Expand Down
Loading