aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2017-08-03 21:03:32 +0300
committerIgor Pashev <pashev.igor@gmail.com>2017-08-03 21:29:29 +0300
commit65b71a99fdb60ad063cb7e8976143027b1e260e7 (patch)
treee5f95ea9f7567c93d9ed1f200c46a5fd9bc1a586
parenta843eb759bd7f955f95254ee93165968be39bbb0 (diff)
downloadmywatch-65b71a99fdb60ad063cb7e8976143027b1e260e7.tar.gz
hindent wins
-rw-r--r--.hindent.yaml3
-rw-r--r--.stylish-haskell.yaml189
-rw-r--r--src/Application.hs108
-rw-r--r--src/LogFormat.hs58
-rw-r--r--src/Main.hs72
-rw-r--r--src/Server.hs80
6 files changed, 170 insertions, 340 deletions
diff --git a/.hindent.yaml b/.hindent.yaml
new file mode 100644
index 0000000..3dba089
--- /dev/null
+++ b/.hindent.yaml
@@ -0,0 +1,3 @@
+indent-size: 2
+line-length: 80
+force-trailing-newline: true
diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml
deleted file mode 100644
index de87c17..0000000
--- a/.stylish-haskell.yaml
+++ /dev/null
@@ -1,189 +0,0 @@
-# stylish-haskell configuration file
-# ==================================
-
-# The stylish-haskell tool is mainly configured by specifying steps. These steps
-# are a list, so they have an order, and one specific step may appear more than
-# once (if needed). Each file is processed by these steps in the given order.
-steps:
- # Convert some ASCII sequences to their Unicode equivalents. This is disabled
- # by default.
- # - unicode_syntax:
- # # In order to make this work, we also need to insert the UnicodeSyntax
- # # language pragma. If this flag is set to true, we insert it when it's
- # # not already present. You may want to disable it if you configure
- # # language extensions using some other method than pragmas. Default:
- # # true.
- # add_language_pragma: true
-
- # Align the right hand side of some elements. This is quite conservative
- # and only applies to statements where each element occupies a single
- # line.
- - simple_align:
- cases: true
- top_level_patterns: true
- records: true
-
- # Import cleanup
- - imports:
- # There are different ways we can align names and lists.
- #
- # - global: Align the import names and import list throughout the entire
- # file.
- #
- # - file: Like global, but don't add padding when there are no qualified
- # imports in the file.
- #
- # - group: Only align the imports per group (a group is formed by adjacent
- # import lines).
- #
- # - none: Do not perform any alignment.
- #
- # Default: global.
- align: none
-
- # Folowing options affect only import list alignment.
- #
- # List align has following options:
- #
- # - after_alias: Import list is aligned with end of import including
- # 'as' and 'hiding' keywords.
- #
- # > import qualified Data.List as List (concat, foldl, foldr, head,
- # > init, last, length)
- #
- # - with_alias: Import list is aligned with start of alias or hiding.
- #
- # > import qualified Data.List as List (concat, foldl, foldr, head,
- # > init, last, length)
- #
- # - new_line: Import list starts always on new line.
- #
- # > import qualified Data.List as List
- # > (concat, foldl, foldr, head, init, last, length)
- #
- # Default: after_alias
- list_align: after_alias
-
- # Long list align style takes effect when import is too long. This is
- # determined by 'columns' setting.
- #
- # - inline: This option will put as much specs on same line as possible.
- #
- # - new_line: Import list will start on new line.
- #
- # - new_line_multiline: Import list will start on new line when it's
- # short enough to fit to single line. Otherwise it'll be multiline.
- #
- # - multiline: One line per import list entry.
- # Type with contructor list acts like single import.
- #
- # > import qualified Data.Map as M
- # > ( empty
- # > , singleton
- # > , ...
- # > , delete
- # > )
- #
- # Default: inline
- long_list_align: inline
-
- # Align empty list (importing instances)
- #
- # Empty list align has following options
- #
- # - inherit: inherit list_align setting
- #
- # - right_after: () is right after the module name:
- #
- # > import Vector.Instances ()
- #
- # Default: inherit
- empty_list_align: inherit
-
- # List padding determines indentation of import list on lines after import.
- # This option affects 'long_list_align'.
- #
- # - <integer>: constant value
- #
- # - module_name: align under start of module name.
- # Useful for 'file' and 'group' align settings.
- list_padding: 4
-
- # Separate lists option affects formating of import list for type
- # or class. The only difference is single space between type and list
- # of constructors, selectors and class functions.
- #
- # - true: There is single space between Foldable type and list of it's
- # functions.
- #
- # > import Data.Foldable (Foldable (fold, foldl, foldMap))
- #
- # - false: There is no space between Foldable type and list of it's
- # functions.
- #
- # > import Data.Foldable (Foldable(fold, foldl, foldMap))
- #
- # Default: true
- separate_lists: true
-
- # Language pragmas
- - language_pragmas:
- # We can generate different styles of language pragma lists.
- #
- # - vertical: Vertical-spaced language pragmas, one per line.
- #
- # - compact: A more compact style.
- #
- # - compact_line: Similar to compact, but wrap each line with
- # `{-#LANGUAGE #-}'.
- #
- # Default: vertical.
- style: vertical
-
- # Align affects alignment of closing pragma brackets.
- #
- # - true: Brackets are aligned in same collumn.
- #
- # - false: Brackets are not aligned together. There is only one space
- # between actual import and closing bracket.
- #
- # Default: true
- align: true
-
- # stylish-haskell can detect redundancy of some language pragmas. If this
- # is set to true, it will remove those redundant pragmas. Default: true.
- remove_redundant: true
-
- # Replace tabs by spaces. This is disabled by default.
- # - tabs:
- # # Number of spaces to use for each tab. Default: 8, as specified by the
- # # Haskell report.
- # spaces: 8
-
- # Remove trailing whitespace
- - trailing_whitespace: {}
-
-# A common setting is the number of columns (parts of) code will be wrapped
-# to. Different steps take this into account. Default: 80.
-columns: 80
-
-# By default, line endings are converted according to the OS. You can override
-# preferred format here.
-#
-# - native: Native newline format. CRLF on Windows, LF on other OSes.
-#
-# - lf: Convert to LF ("\n").
-#
-# - crlf: Convert to CRLF ("\r\n").
-#
-# Default: native.
-newline: lf
-
-# Sometimes, language extensions are specified in a cabal file or from the
-# command line instead of using language pragmas in the file. stylish-haskell
-# needs to be aware of these, so it can parse the file correctly.
-#
-# No language extensions are enabled by default.
-# language_extensions:
- # - TemplateHaskell
- # - QuasiQuotes
diff --git a/src/Application.hs b/src/Application.hs
index 0b7ca52..5624aec 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-module Application (
- app
-) where
+module Application
+ ( app
+ ) where
import Prelude hiding (id)
@@ -17,21 +17,23 @@ import qualified Data.HashMap.Lazy as HM
import Data.List (sort)
import Data.Pool (Pool, withResource)
import Data.Text.Lazy (Text)
-import Database.MySQL.Simple (Connection, Only (..), execute, query_)
+import Database.MySQL.Simple
+ (Connection, Only(..), execute, query_)
import GHC.Generics (Generic)
-import Network.HTTP.Types (StdMethod (HEAD), notFound404, notImplemented501,
- ok200)
+import Network.HTTP.Types
+ (StdMethod(HEAD), notFound404, notImplemented501, ok200)
import Network.Wai (Application, Middleware)
import qualified Network.Wai.Middleware.Gzip as Gzip
-import Network.Wai.Middleware.RequestLogger (Destination (Handle),
- OutputFormat (CustomOutputFormat),
- RequestLoggerSettings (destination, outputFormat),
- mkRequestLogger)
-import Network.Wai.Middleware.Static (addBase, hasPrefix, staticPolicy, (>->))
+import Network.Wai.Middleware.RequestLogger
+ (Destination(Handle), OutputFormat(CustomOutputFormat),
+ RequestLoggerSettings(destination, outputFormat), mkRequestLogger)
+import Network.Wai.Middleware.Static
+ ((>->), addBase, hasPrefix, staticPolicy)
import System.FilePath.Posix ((</>))
import System.IO (stderr)
-import Web.Scotty (ActionM, ScottyM, addroute, delete, file, get, json,
- middleware, param, scottyApp, status, text)
+import Web.Scotty
+ (ActionM, ScottyM, addroute, delete, file, get, json, middleware,
+ param, scottyApp, status, text)
import LogFormat (logFormat)
@@ -39,37 +41,35 @@ type Pools = HM.HashMap Text (Pool Connection)
app :: Pools -> FilePath -> IO Application
app ps f = do
- logger <- mkRequestLogger def{ destination = Handle stderr
- , outputFormat = CustomOutputFormat logFormat }
+ logger <-
+ mkRequestLogger
+ def
+ {destination = Handle stderr, outputFormat = CustomOutputFormat logFormat}
scottyApp (myProcess ps logger f)
-myProcess :: Pools -> Middleware -> FilePath -> ScottyM ()
+myProcess :: Pools -> Middleware -> FilePath -> ScottyM ()
myProcess ps logger dataDir = do
middleware logger
-
middleware $ Gzip.gzip Gzip.def {Gzip.gzipFiles = Gzip.GzipCompress}
-
middleware $ staticPolicy (hasPrefix "static" >-> addBase dataDir)
get "/" $ file (dataDir </> "app.html")
-
get "/serverlist.json" $ json (sort $ HM.keys ps)
get "/server/:server/processlist.json" $ apiGetProcessList ps
-
-- Used by client to see which servers are really allowed by Sproxy
addroute HEAD "/server/:server/processlist.json" $ apiCanProcessList ps
-
delete "/server/:server/process/:id" $ apiKill ps
-data Process = Process {
- id :: Int
- , user :: Text
- , host :: Text
- , db :: Maybe Text
+data Process = Process
+ { id :: Int
+ , user :: Text
+ , host :: Text
+ , db :: Maybe Text
, command :: Text
- , time :: Int
- , state :: Maybe Text
- , info :: Text
-} deriving (Generic)
+ , time :: Int
+ , state :: Maybe Text
+ , info :: Text
+ } deriving (Generic)
+
instance ToJSON Process
apiCanProcessList :: Pools -> ActionM ()
@@ -77,40 +77,50 @@ apiCanProcessList ps = do
server <- param "server"
case HM.lookup server ps of
Nothing -> status notFound404 >> text server
- Just _ -> status ok200
+ Just _ -> status ok200
apiKill :: Pools -> ActionM ()
apiKill ps = do
server <- param "server"
case HM.lookup server ps of
Nothing -> status notFound404 >> text server
- Just p -> do
+ Just p -> do
id <- param "id"
- if (id :: Int) == 0 then do
- [ Only f ] <- withDB p $ \c ->
- query_ c "SELECT COUNT(*) FROM information_schema.routines \
+ if (id :: Int) == 0
+ then do
+ [Only f] <-
+ withDB p $ \c ->
+ query_
+ c
+ "SELECT COUNT(*) FROM information_schema.routines \
\WHERE routine_type = 'PROCEDURE' AND routine_schema = 'mysql' \
\AND routine_name = 'mywatch_kill'"
- if (f::Int) > 0 then status ok200
- else status notImplemented501 >> text "mywatch_kill"
- else do
- _ <- withDB p $ \c -> execute c "CALL mysql.mywatch_kill(?)" [ id ]
- status ok200
+ if (f :: Int) > 0
+ then status ok200
+ else status notImplemented501 >> text "mywatch_kill"
+ else do
+ _ <- withDB p $ \c -> execute c "CALL mysql.mywatch_kill(?)" [id]
+ status ok200
apiGetProcessList :: Pools -> ActionM ()
apiGetProcessList ps = do
server <- param "server"
case HM.lookup server ps of
Nothing -> status notFound404 >> text server
- Just p -> do
- res <- withDB p $ \c ->
- query_ c "SELECT \
+ Just p -> do
+ res <-
+ withDB p $ \c ->
+ query_
+ c
+ "SELECT \
\id, user, host, db, command, time, state, info \
\FROM information_schema.processlist \
\WHERE info IS NOT NULL \
\ORDER BY time DESC, id ASC"
- json $ map (\(id, user, host, db, command, time, state, info) -> Process {..}) res
+ json $
+ map
+ (\(id, user, host, db, command, time, state, info) -> Process {..})
+ res
withDB :: Pool Connection -> (Connection -> IO a) -> ActionM a
withDB p a = liftIO $ withResource p (liftIO . a)
-
diff --git a/src/LogFormat.hs b/src/LogFormat.hs
index b1fc488..2957e97 100644
--- a/src/LogFormat.hs
+++ b/src/LogFormat.hs
@@ -1,40 +1,40 @@
{-# LANGUAGE OverloadedStrings #-}
-module LogFormat (
- logFormat
-) where
+module LogFormat
+ ( logFormat
+ ) where
import qualified Data.ByteString.Char8 as BS
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
-import Network.HTTP.Types (Status (statusCode))
-import Network.Wai (Request, httpVersion, rawPathInfo, requestHeaderReferer,
- requestHeaderUserAgent, requestHeaders, requestMethod)
+import Network.HTTP.Types (Status(statusCode))
+import Network.Wai
+ (Request, httpVersion, rawPathInfo, requestHeaderReferer,
+ requestHeaderUserAgent, requestHeaders, requestMethod)
import System.Log.FastLogger (LogStr, toLogStr)
-- Sligthly modified Combined Log Format.
-- User ID extracted from the From header.
logFormat :: BS.ByteString -> Request -> Status -> Maybe Integer -> LogStr
-logFormat t req st msize = ""
- <> toLogStr (fromMaybe "-" $ lookup "X-Forwarded-For" headers)
- <> " - "
- <> toLogStr (fromMaybe "-" $ lookup "From" headers)
- <> " ["
- <> toLogStr t
- <> "] \""
- <> toLogStr (requestMethod req)
- <> " "
- <> toLogStr (rawPathInfo req)
- <> " "
- <> toLogStr (show $ httpVersion req)
- <> "\" "
- <> toLogStr (show $ statusCode st)
- <> " "
- <> toLogStr (maybe "-" show msize)
- <> " \""
- <> toLogStr (fromMaybe "" $ requestHeaderReferer req)
- <> "\" \""
- <> toLogStr (fromMaybe "" $ requestHeaderUserAgent req)
- <> "\"\n"
- where headers = requestHeaders req
-
+logFormat t req st msize =
+ "" <> toLogStr (fromMaybe "-" $ lookup "X-Forwarded-For" headers) <> " - " <>
+ toLogStr (fromMaybe "-" $ lookup "From" headers) <>
+ " [" <>
+ toLogStr t <>
+ "] \"" <>
+ toLogStr (requestMethod req) <>
+ " " <>
+ toLogStr (rawPathInfo req) <>
+ " " <>
+ toLogStr (show $ httpVersion req) <>
+ "\" " <>
+ toLogStr (show $ statusCode st) <>
+ " " <>
+ toLogStr (maybe "-" show msize) <>
+ " \"" <>
+ toLogStr (fromMaybe "" $ requestHeaderReferer req) <>
+ "\" \"" <>
+ toLogStr (fromMaybe "" $ requestHeaderUserAgent req) <>
+ "\"\n"
+ where
+ headers = requestHeaders req
diff --git a/src/Main.hs b/src/Main.hs
index 532bf02..58083a4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,8 +1,8 @@
{-# LANGUAGE QuasiQuotes #-}
-module Main (
- main
-) where
+module Main
+ ( main
+ ) where
import Data.ByteString.Char8 (pack)
import qualified Data.ConfigFile as Cf
@@ -10,8 +10,9 @@ import Data.Either.Utils (forceEither)
import Data.List (isPrefixOf)
import Data.Maybe (fromJust)
import Data.Version (showVersion)
-import Database.MySQL.Base (ConnectInfo (..), defaultSSLInfo)
-import Database.MySQL.Base.Types (Option (ReadDefaultFile, ReadDefaultGroup))
+import Database.MySQL.Base (ConnectInfo(..), defaultSSLInfo)
+import Database.MySQL.Base.Types
+ (Option(ReadDefaultFile, ReadDefaultGroup))
import Paths_mywatch (getDataDir, version)
import qualified System.Console.Docopt.NoTH as O
import System.Environment (getArgs)
@@ -23,8 +24,10 @@ usage :: IO String
usage = do
dataDir <- getDataDir
return $
- "mywatch " ++ showVersion version
- ++ " view queries on many MySQL servers" ++ [qc|
+ "mywatch " ++
+ showVersion version ++
+ " view queries on many MySQL servers" ++
+ [qc|
Usage:
mywatch [options] MYCNF
@@ -40,35 +43,38 @@ Options:
|]
-main :: IO()
+main :: IO ()
main = do
doco <- O.parseUsageOrExit =<< usage
args <- O.parseArgsOrExit doco =<< getArgs
if args `O.isPresent` O.longOption "help"
- then putStrLn $ O.usage doco
- else do
- let
- file = fromJust $ O.getArg args $ O.argument "MYCNF"
- port = O.getArg args $ O.longOption "port"
- socket = fromJust $ O.getArg args $ O.longOption "socket"
- datadir = fromJust $ O.getArg args $ O.longOption "datadir"
-
- cf <- forceEither <$> Cf.readfile Cf.emptyCP file
- let
- servers = filter ("client" /=) . Cf.sections $ cf
- myInfo = map (\g -> ConnectInfo {
- connectDatabase = "",
- connectHost = "",
- connectPassword = "",
- connectPath = "",
- connectPort = 0,
+ then putStrLn $ O.usage doco
+ else do
+ let file = fromJust $ O.getArg args $ O.argument "MYCNF"
+ port = O.getArg args $ O.longOption "port"
+ socket = fromJust $ O.getArg args $ O.longOption "socket"
+ datadir = fromJust $ O.getArg args $ O.longOption "datadir"
+ cf <- forceEither <$> Cf.readfile Cf.emptyCP file
+ let servers = filter ("client" /=) . Cf.sections $ cf
+ myInfo =
+ map
+ (\g ->
+ ConnectInfo
+ { connectDatabase = ""
+ , connectHost = ""
+ , connectPassword = ""
+ , connectPath = ""
+ , connectPort = 0
-- FIXME: https://jira.mariadb.org/browse/MDEV-10246
- connectSSL = if any (isPrefixOf "ssl") (forceEither $ Cf.options cf g)
- then Just defaultSSLInfo else Nothing,
- connectUser = "",
+ , connectSSL =
+ if any (isPrefixOf "ssl") (forceEither $ Cf.options cf g)
+ then Just defaultSSLInfo
+ else Nothing
+ , connectUser = ""
-- FIXME: Work aroung buggy mysql: unsafeUseAsCString creates garbage.
- connectOptions = [ ReadDefaultFile file, ReadDefaultGroup (pack $ g ++ "\0") ]
- }) servers
- listen = maybe (Right socket) (Left . read) port
- server listen myInfo datadir
-
+ , connectOptions =
+ [ReadDefaultFile file, ReadDefaultGroup (pack $ g ++ "\0")]
+ })
+ servers
+ listen = maybe (Right socket) (Left . read) port
+ server listen myInfo datadir
diff --git a/src/Server.hs b/src/Server.hs
index 622b61b..45d2723 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -1,7 +1,6 @@
module Server
-(
- server
-) where
+ ( server
+ ) where
import Control.Exception.Base (bracket, catch, throwIO)
import Data.Bits ((.|.))
@@ -12,60 +11,63 @@ import Data.Maybe (fromJust)
import Data.Pool (createPool, destroyAllResources)
import Data.Text.Lazy (Text)
import Data.Text.Lazy.Encoding (decodeUtf8)
-import Database.MySQL.Base (ConnectInfo (connectOptions))
-import Database.MySQL.Base.Types (Option (ReadDefaultGroup))
+import Database.MySQL.Base (ConnectInfo(connectOptions))
+import Database.MySQL.Base.Types (Option(ReadDefaultGroup))
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 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 (groupReadMode, groupWriteMode, ownerReadMode,
- ownerWriteMode, removeLink, setFileMode, socketMode)
+import System.Posix.Files
+ (groupReadMode, groupWriteMode, ownerReadMode, ownerWriteMode,
+ removeLink, setFileMode, socketMode)
import Application (app)
type Listen = Either Port FilePath
-
server :: Listen -> [ConnectInfo] -> FilePath -> IO ()
server socketSpec mysqlConnInfo dataDir =
bracket
- ( do
- sock <- createSocket socketSpec
- mysql <- HM.fromList <$> mapM (\c -> do
- p <- createPool (MySQL.connect c) MySQL.close 1 60 10
- return (getGroup c, p)) mysqlConnInfo
- return (sock, mysql) )
- ( \(sock, mysql) -> do
- closeSocket sock
- mapM_ destroyAllResources $ HM.elems mysql )
- ( \(sock, mysql) -> do
- listen sock maxListenQueue
- hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"
- runSettingsSocket defaultSettings sock =<< app mysql dataDir )
+ (do sock <- createSocket socketSpec
+ mysql <-
+ HM.fromList <$>
+ mapM
+ (\c -> do
+ p <- createPool (MySQL.connect c) MySQL.close 1 60 10
+ return (getGroup c, p))
+ mysqlConnInfo
+ return (sock, mysql))
+ (\(sock, mysql) -> do
+ closeSocket sock
+ mapM_ destroyAllResources $ HM.elems mysql)
+ (\(sock, mysql) -> do
+ listen sock maxListenQueue
+ hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"
+ runSettingsSocket defaultSettings sock =<< app mysql dataDir)
getGroup :: ConnectInfo -> Text
getGroup = decodeUtf8 . getName . fromJust . find isGroup . connectOptions
where
isGroup (ReadDefaultGroup _) = True
- isGroup _ = False
+ isGroup _ = False
-- FIXME: Removing trailing zero added for buggy mysql in Main.hs.
getName (ReadDefaultGroup n) = LBS.takeWhile (0 /=) . LBS.fromStrict $ n
- getName _ = error "Cannot happen"
-
+ getName _ = error "Cannot happen"
createSocket :: Listen -> IO Socket
createSocket (Right 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
@@ -76,19 +78,17 @@ createSocket (Left port) = do
hPutStrLn stderr $ "Listening on localhost:" ++ show port
return sock
-
closeSocket :: Socket -> IO ()
closeSocket sock = do
name <- getSocketName sock
close sock
case name of
SockAddrUnix path -> removeIfExists path
- _ -> return ()
-
+ _ -> 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