Remove protolude since the library seems a bit stale and we can replace

the interesting bits with a simpler module.

Author: diogob

Setup.hs

@@ -1,2 +1,3 @@
 import Distribution.Simple
+
 main = defaultMain

app/Main.hs

@@ -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

postgres-websockets.cabal

@@ -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
@@ -29,6 +29,7 @@ library
                      , PostgresWebsockets.HasqlBroadcast
                      , PostgresWebsockets.Claims
                      , PostgresWebsockets.Config
+                     , APrelude
 
   autogen-modules:     Paths_postgres_websockets
   other-modules:       Paths_postgres_websockets
@@ -49,8 +50,9 @@ library
                      , http-types >= 0.12.3 && < 0.13
                      , jose >= 0.11 && < 0.12
                      , lens >= 5.2.3 && < 5.4
+                     , mtl
+                     , async
                      , 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
@@ -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
@@ -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

src/APrelude.hs

@@ -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

src/PostgresWebsockets.hs

@@ -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)

src/PostgresWebsockets/Broadcast.hs

@@ -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
@@ -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)
@@ -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
               <> " -> "
@@ -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)