From 3535557c1d89b1bc22806305bc7b6c1a350cf413 Mon Sep 17 00:00:00 2001
From: Igor Pashev <pashev.igor@gmail.com>
Date: Wed, 17 Mar 2021 10:12:11 +0200
Subject: Use optparse-applicative instead of docopt

---
 src/Server.hs | 98 ++++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 57 insertions(+), 41 deletions(-)

(limited to 'src/Server.hs')

diff --git a/src/Server.hs b/src/Server.hs
index 10d4328..14d7579 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -1,60 +1,78 @@
 module Server
-(
-  server
-) where
+  ( Listen(..)
+  , server
+  ) where
 
-import Control.Exception.Base (throwIO, catch, bracket)
+import Control.Exception.Base (bracket, catch, throwIO)
 import Data.Bits ((.|.))
 import Data.Pool (createPool, destroyAllResources)
 import Database.MySQL.Base (ConnectInfo)
-import Network.Socket (socket, setSocketOption, bind, listen, close,
-  maxListenQueue, getSocketName, inet_addr, Family(AF_UNIX, AF_INET),
-  SocketType(Stream), SocketOption(ReuseAddr), Socket, SockAddr(SockAddrUnix,
-  SockAddrInet))
+import qualified Database.MySQL.Simple as MySQL
+import Network.Socket
+  ( Family(AF_INET, AF_UNIX)
+  , SockAddr(SockAddrInet, SockAddrUnix)
+  , Socket
+  , SocketOption(ReuseAddr)
+  , SocketType(Stream)
+  , bind
+  , close
+  , getSocketName
+  , inet_addr
+  , listen
+  , maxListenQueue
+  , setSocketOption
+  , socket
+  )
 import Network.Wai.Handler.Warp (Port, defaultSettings, runSettingsSocket)
 import System.IO (hPutStrLn, stderr)
 import System.IO.Error (isDoesNotExistError)
-import System.Posix.Files (removeLink, setFileMode, socketMode, ownerReadMode,
-  ownerWriteMode, groupReadMode, groupWriteMode)
-import qualified Database.MySQL.Simple as MySQL
+import System.Posix.Files
+  ( groupReadMode
+  , groupWriteMode
+  , ownerReadMode
+  , ownerWriteMode
+  , removeLink
+  , setFileMode
+  , socketMode
+  )
 
 import Application (app)
 
-type Listen = Either Port FilePath
-
+data Listen
+  = Socket FilePath
+  | Port Int
 
 server :: Listen -> ConnectInfo -> FilePath -> IO ()
 server socketSpec mysqlConnInfo dataDir =
   bracket
-    ( do
-      sock <- createSocket socketSpec
-      mysql <- createPool
-                (MySQL.connect mysqlConnInfo)
-                MySQL.close
-                1 -- stripes
-                60 -- keep alive (seconds)
-                10 -- max connections
-      return (sock, mysql) )
-    ( \(sock, mysql) -> do
-      closeSocket sock
-      destroyAllResources mysql )
-    ( \(sock, mysql) -> do
-      listen sock maxListenQueue
-      hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"
-      runSettingsSocket defaultSettings sock =<< app mysql dataDir)
-
+    (do sock <- createSocket socketSpec
+        mysql <-
+          createPool
+            (MySQL.connect mysqlConnInfo)
+            MySQL.close
+            1 -- stripes
+            60 -- keep alive (seconds)
+            10 -- max connections
+        return (sock, mysql))
+    (\(sock, mysql) -> do
+       closeSocket sock
+       destroyAllResources mysql)
+    (\(sock, mysql) -> do
+       listen sock maxListenQueue
+       hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"
+       runSettingsSocket defaultSettings sock =<< app mysql dataDir)
 
 createSocket :: Listen -> IO Socket
-createSocket (Right path) = do
+createSocket (Socket path) = do
   removeIfExists path
   sock <- socket AF_UNIX Stream 0
   bind sock $ SockAddrUnix path
-  setFileMode path $ socketMode
-                  .|. ownerWriteMode .|. ownerReadMode
-                  .|. groupWriteMode .|. groupReadMode
+  setFileMode path $
+    socketMode .|. ownerWriteMode .|. ownerReadMode .|. groupWriteMode .|.
+    groupReadMode
   hPutStrLn stderr $ "Listening on UNIX socket `" ++ path ++ "'"
   return sock
-createSocket (Left port) = do
+createSocket (Port port) = do
   sock <- socket AF_INET Stream 0
   setSocketOption sock ReuseAddr 1
   addr <- inet_addr "127.0.0.1"
@@ -62,7 +80,6 @@ createSocket (Left port) = do
   hPutStrLn stderr $ "Listening on localhost:" ++ show port
   return sock
 
-
 closeSocket :: Socket -> IO ()
 closeSocket sock = do
   name <- getSocketName sock
@@ -71,10 +88,9 @@ closeSocket sock = do
     SockAddrUnix path -> removeIfExists path
     _ -> return ()
 
-
 removeIfExists :: FilePath -> IO ()
 removeIfExists fileName = removeLink fileName `catch` handleExists
-  where handleExists e
-          | isDoesNotExistError e = return ()
-          | otherwise = throwIO e
-
+  where
+    handleExists e
+      | isDoesNotExistError e = return ()
+      | otherwise = throwIO e
-- 
cgit v1.2.3