diff options
| -rw-r--r-- | .stylish-haskell.yaml | 189 | ||||
| -rw-r--r-- | src/Application.hs | 28 | ||||
| -rw-r--r-- | src/LogFormat.hs | 8 | ||||
| -rw-r--r-- | src/Main.hs | 12 | ||||
| -rw-r--r-- | src/Server.hs | 33 |
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 () |