aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.stylish-haskell.yaml189
-rw-r--r--src/Application.hs28
-rw-r--r--src/LogFormat.hs8
-rw-r--r--src/Main.hs12
-rw-r--r--src/Server.hs33
5 files changed, 231 insertions, 39 deletions
diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml
new file mode 100644
index 0000000..de87c17
--- /dev/null
+++ b/.stylish-haskell.yaml
@@ -0,0 +1,189 @@
+# 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 3c57079..0b7ca52 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Application (
@@ -13,23 +13,25 @@ import Prelude hiding (id)
import Control.Monad.Trans (liftIO)
import Data.Aeson (ToJSON)
import Data.Default.Class (def)
+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(..), query_, execute)
+import Database.MySQL.Simple (Connection, Only (..), execute, query_)
import GHC.Generics (Generic)
-import Network.HTTP.Types (ok200, notFound404, notImplemented501, StdMethod(HEAD))
+import Network.HTTP.Types (StdMethod (HEAD), notFound404, notImplemented501,
+ ok200)
import Network.Wai (Application, Middleware)
-import Network.Wai.Middleware.RequestLogger (Destination(Handle),
- mkRequestLogger, RequestLoggerSettings(destination, outputFormat),
- OutputFormat(CustomOutputFormat))
+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 System.FilePath.Posix ((</>))
import System.IO (stderr)
-import Web.Scotty (ScottyM, ActionM, middleware, json, file, addroute, get,
- delete, status, text, param, scottyApp)
-import qualified Data.HashMap.Lazy as HM
-import qualified Network.Wai.Middleware.Gzip as Gzip
+import Web.Scotty (ActionM, ScottyM, addroute, delete, file, get, json,
+ middleware, param, scottyApp, status, text)
import LogFormat (logFormat)
diff --git a/src/LogFormat.hs b/src/LogFormat.hs
index 9eb25f1..b1fc488 100644
--- a/src/LogFormat.hs
+++ b/src/LogFormat.hs
@@ -4,13 +4,13 @@ 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, requestHeaders, requestMethod,
- rawPathInfo, requestHeaderReferer, requestHeaderUserAgent)
+import Network.HTTP.Types (Status (statusCode))
+import Network.Wai (Request, httpVersion, rawPathInfo, requestHeaderReferer,
+ requestHeaderUserAgent, requestHeaders, requestMethod)
import System.Log.FastLogger (LogStr, toLogStr)
-import qualified Data.ByteString.Char8 as BS
-- Sligthly modified Combined Log Format.
-- User ID extracted from the From header.
diff --git a/src/Main.hs b/src/Main.hs
index e9a29b7..532bf02 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -5,17 +5,17 @@ module Main (
) where
import Data.ByteString.Char8 (pack)
+import qualified Data.ConfigFile as Cf
import Data.Either.Utils (forceEither)
-import Data.Maybe (fromJust)
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 Paths_mywatch (getDataDir, version) -- from cabal
+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)
import Text.InterpolatedString.Perl6 (qc)
-import qualified Data.ConfigFile as Cf
-import qualified System.Console.Docopt.NoTH as O
import Server (server)
diff --git a/src/Server.hs b/src/Server.hs
index 40ae921..622b61b 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -3,27 +3,28 @@ module Server
server
) where
-import Control.Exception.Base (throwIO, catch, bracket)
+import Control.Exception.Base (bracket, catch, throwIO)
import Data.Bits ((.|.))
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.HashMap.Lazy as HM
import Data.List (find)
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 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 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 System.IO (hPutStrLn, stderr)
import System.IO.Error (isDoesNotExistError)
-import System.Posix.Files (removeLink, setFileMode, socketMode, ownerReadMode,
- ownerWriteMode, groupReadMode, groupWriteMode)
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.HashMap.Lazy as HM
-import qualified Database.MySQL.Simple as MySQL
+import System.Posix.Files (groupReadMode, groupWriteMode, ownerReadMode,
+ ownerWriteMode, removeLink, setFileMode, socketMode)
import Application (app)
@@ -45,16 +46,16 @@ server socketSpec mysqlConnInfo dataDir =
( \(sock, mysql) -> do
listen sock maxListenQueue
hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"
- runSettingsSocket defaultSettings sock =<< app mysql 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
@@ -82,7 +83,7 @@ closeSocket sock = do
close sock
case name of
SockAddrUnix path -> removeIfExists path
- _ -> return ()
+ _ -> return ()
removeIfExists :: FilePath -> IO ()