From: PHO Date: Thu, 13 Oct 2011 13:14:17 +0000 (+0900) Subject: Cosmetic changes suggested by hlint. X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=6126eb9;p=Lucu.git Cosmetic changes suggested by hlint. Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa --- diff --git a/ImplantFile.hs b/ImplantFile.hs index 0e91f1c..3b80e60 100644 --- a/ImplantFile.hs +++ b/ImplantFile.hs @@ -159,12 +159,10 @@ mkImports useGZip False False Nothing Nothing Nothing ] ⧺ - if useGZip then - [ ImportDecl (⊥) (ModuleName "Codec.Compression.GZip") - False False Nothing Nothing Nothing - ] - else - [] + [ ImportDecl (⊥) (ModuleName "Codec.Compression.GZip") + False False Nothing Nothing Nothing + | useGZip + ] resourceDecl ∷ Name → Bool → [Decl] resourceDecl symName useGZip @@ -234,22 +232,22 @@ resGetRaw setContentEncodingGZipStmt ∷ Stmt setContentEncodingGZipStmt = qualStmt $ - metaFunction "setContentEncoding" $ - [ listE [ strE "gzip" ] ] + metaFunction "setContentEncoding" + [ listE [ strE "gzip" ] ] foundEntityStmt ∷ Stmt foundEntityStmt = qualStmt $ - metaFunction "foundEntity" $ - [ var $ name "entityTag" - , var $ name "lastModified" - ] + metaFunction "foundEntity" + [ var $ name "entityTag" + , var $ name "lastModified" + ] setContentTypeStmt ∷ Stmt setContentTypeStmt = qualStmt $ - metaFunction "setContentType" $ - [var $ name "contentType"] + metaFunction "setContentType" + [var $ name "contentType"] outputStmt ∷ Exp → Stmt outputStmt e @@ -342,9 +340,9 @@ eTagToString = A.toString ∘ A.fromAsciiBuilder ∘ printETag getModuleName ∷ [CmdOpt] → IO ModuleName getModuleName opts = case modNameOpts of - [] → fail "a module name must be given." - (OptModName modName):[] → return $ ModuleName modName - _ → fail "too many --module options." + [] → fail "a module name must be given." + OptModName modName:[] → return $ ModuleName modName + _ → fail "too many --module options." where modNameOpts ∷ [CmdOpt] modNameOpts = filter (\ x → case x of @@ -354,9 +352,9 @@ getModuleName opts getSymbolName ∷ [CmdOpt] → ModuleName → IO Name getSymbolName opts (ModuleName modName) = case symNameOpts of - [] → return defaultSymName - (OptSymName symName):[] → return $ name symName - _ → fail "too many --symbol options." + [] → return defaultSymName + OptSymName symName:[] → return $ name symName + _ → fail "too many --symbol options." where symNameOpts ∷ [CmdOpt] symNameOpts = filter (\ x → case x of @@ -378,7 +376,7 @@ getMIMEType ∷ [CmdOpt] → FilePath → IO MIMEType getMIMEType opts srcFile = case mimeTypeOpts of [] → return defaultType - (OptMIMEType ty):[] + OptMIMEType ty:[] → case A.fromChars ty of Just a → return $ parseMIMEType a Nothing → fail "MIME type must not contain any non-ASCII letters." @@ -406,9 +404,9 @@ getLastModified fpath = (posixSecondsToUTCTime ∘ fromRational ∘ toRational getETag ∷ [CmdOpt] → Lazy.ByteString → IO ETag getETag opts input = case eTagOpts of - [] → return $ mkETagFromInput - (OptETag str):[] → return $ strToETag str - _ → fail "too many --etag options." + [] → return mkETagFromInput + OptETag str:[] → return $ strToETag str + _ → fail "too many --etag options." where eTagOpts ∷ [CmdOpt] eTagOpts = filter (\ x → case x of @@ -432,9 +430,9 @@ openInput fpath = Lazy.readFile fpath openOutput ∷ [CmdOpt] → IO Handle openOutput opts = case outputOpts of - [] → return stdout - (OptOutput fpath):[] → openFile fpath WriteMode - _ → fail "two many --output options." + [] → return stdout + OptOutput fpath:[] → openFile fpath WriteMode + _ → fail "two many --output options." where outputOpts ∷ [CmdOpt] outputOpts = filter (\ x → case x of diff --git a/Network/HTTP/Lucu/Authorization.hs b/Network/HTTP/Lucu/Authorization.hs index d91fe29..789b5d1 100644 --- a/Network/HTTP/Lucu/Authorization.hs +++ b/Network/HTTP/Lucu/Authorization.hs @@ -29,7 +29,7 @@ import Prelude.Unicode -- \"WWW-Authenticate\" header. See -- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'. data AuthChallenge - = BasicAuthChallenge Realm + = BasicAuthChallenge !Realm deriving (Eq) -- |'Realm' is just a string which must not contain any non-ASCII letters. @@ -39,7 +39,7 @@ type Realm = Ascii -- \"Authorization\" header. See -- 'Network.HTTP.Lucu.Resource.getAuthorization'. data AuthCredential - = BasicAuthCredential UserID Password + = BasicAuthCredential !UserID !Password deriving (Show, Eq) -- |'UserID' is just a string which must not contain colon and any diff --git a/Network/HTTP/Lucu/ContentCoding.hs b/Network/HTTP/Lucu/ContentCoding.hs index 315d237..3ce7806 100644 --- a/Network/HTTP/Lucu/ContentCoding.hs +++ b/Network/HTTP/Lucu/ContentCoding.hs @@ -47,20 +47,12 @@ accEncP = do coding ← toCIAscii <$> token normalizeCoding ∷ CIAscii → CIAscii normalizeCoding coding - = if coding ≡ "x-gzip" then - "gzip" - else - if coding ≡ "x-compress" then - "compress" - else - coding + | coding ≡ "x-gzip" = "gzip" + | coding ≡ "x-compress" = "compress" + | otherwise = coding unnormalizeCoding ∷ CIAscii → CIAscii unnormalizeCoding coding - = if coding ≡ "gzip" then - "x-gzip" - else - if coding ≡ "compress" then - "x-compress" - else - coding + | coding ≡ "gzip" = "x-gzip" + | coding ≡ "compress" = "x-compress" + | otherwise = coding diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs index e1bdf1c..b530455 100644 --- a/Network/HTTP/Lucu/DefaultPage.hs +++ b/Network/HTTP/Lucu/DefaultPage.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings , RecordWildCards - , UnboxedTuples , UnicodeSyntax #-} module Network.HTTP.Lucu.DefaultPage diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index 3308bbf..e72022c 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -127,7 +127,7 @@ headersP = do xs ← P.many header {-# INLINE content #-} content = A.unsafeFromByteString <$> - takeWhile1 (\c → ((¬) (isSPHT c)) ∧ isText c) + takeWhile1 (\c → (¬) (isSPHT c) ∧ isText c) joinValues ∷ [Ascii] → Ascii {-# INLINE joinValues #-} diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs index a5db1e2..9ad1c0a 100644 --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -1,9 +1,7 @@ {-# LANGUAGE - BangPatterns - , OverloadedStrings + OverloadedStrings , UnicodeSyntax #-} - -- |Manipulation of HTTP version string. module Network.HTTP.Lucu.HttpVersion ( HttpVersion(..) diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index 0bb92b1..d180202 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -101,7 +101,7 @@ runHttpd cnf tree fbs let addr = head addrs bracketOnError (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) - (sClose) + sClose (\ sock -> do setSocketOption sock ReuseAddr 1 bindSocket sock (addrAddress addr) diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs index 3917cf2..2664d79 100644 --- a/Network/HTTP/Lucu/MIMEType/Guess.hs +++ b/Network/HTTP/Lucu/MIMEType/Guess.hs @@ -93,7 +93,7 @@ compile = M.fromList ∘ concat ∘ map tr -- -- * A definition of module named @moduleName@. -- --- * @variableName ∷ 'ExtMap'@ whose content is a serialization of +-- * @variableName :: 'ExtMap'@ whose content is a serialization of -- @extMap@. -- -- The module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap" is diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs index c36b819..7d0866c 100644 --- a/Network/HTTP/Lucu/MultipartForm.hs +++ b/Network/HTTP/Lucu/MultipartForm.hs @@ -53,7 +53,7 @@ data ContDispo printContDispo ∷ ContDispo → Ascii printContDispo d - = A.fromAsciiBuilder $ + = A.fromAsciiBuilder ( A.toAsciiBuilder (A.fromCIAscii $ dType d) ⊕ printParams (dParams d) ) @@ -122,7 +122,7 @@ getContDispo ∷ Monad m ⇒ Headers → m ContDispo getContDispo hdr = case getHeader "Content-Disposition" hdr of Nothing - → fail ("There is a part without Content-Disposition in the multipart/form-data.") + → fail "There is a part without Content-Disposition in the multipart/form-data." Just str → let p = do d ← contDispoP endOfInput diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs index 5200342..4153dcb 100644 --- a/Network/HTTP/Lucu/Parser/Http.hs +++ b/Network/HTTP/Lucu/Parser/Http.hs @@ -1,6 +1,5 @@ {-# LANGUAGE - BangPatterns - , OverloadedStrings + OverloadedStrings , ScopedTypeVariables , UnicodeSyntax #-} @@ -79,18 +78,16 @@ isChar = (≤ '\x7F') -- c)@ isToken ∷ Char → Bool {-# INLINE isToken #-} -isToken !c - = (¬) (isCtl c ∨ isSeparator c) +isToken c = (¬) (isCtl c ∨ isSeparator c) -- |@'listOf' p@ is similar to @'sepBy' p ('char' \',\')@ but it -- allows any occurrences of 'lws' before and after each tokens. listOf ∷ Parser a → Parser [a] {-# INLINEABLE listOf #-} -listOf p - = do skipMany lws - sepBy p $ do skipMany lws - _ <- char ',' - skipMany lws +listOf p = do skipMany lws + sepBy p $ do skipMany lws + _ ← char ',' + skipMany lws -- |'token' is similar to @'takeWhile1' 'isToken'@ token ∷ Parser Ascii @@ -100,12 +97,12 @@ token = A.unsafeFromByteString <$> takeWhile1 isToken -- |The CRLF: 0x0D 0x0A. crlf ∷ Parser () {-# INLINE crlf #-} -crlf = string "\x0D\x0A" ≫ return () +crlf = string "\x0D\x0A" *> return () -- |The SP: 0x20. sp ∷ Parser () {-# INLINE sp #-} -sp = char '\x20' ≫ return () +sp = char '\x20' *> return () -- |HTTP LWS: crlf? (sp | ht)+ lws ∷ Parser () @@ -142,7 +139,7 @@ quotedStr = try $ quotedPair ∷ Parser Char {-# INLINE quotedPair #-} - quotedPair = char '\\' ≫ satisfy isChar + quotedPair = char '\\' *> satisfy isChar -- |'qvalue' accepts a so-called qvalue. qvalue ∷ Parser Double diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 975744c..87d2a33 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -5,7 +5,7 @@ , RecordWildCards , UnicodeSyntax #-} - +{-# OPTIONS_HADDOCK prune #-} -- |This is the Resource Monad; monadic actions to define the behavior -- of each resources. The 'Resource' Monad is a kind of 'Prelude.IO' -- Monad thus it implements 'Control.Monad.Trans.MonadIO' class. It is @@ -262,9 +262,9 @@ getRequestVersion = reqVersion <$> getRequest -- > -- > resFoo = ResourceDef { -- > resIsGreedy = True --- > , resGet = Just $ do requestURI ← getRequestURI --- > resourcePath ← getResourcePath --- > pathInfo ← getPathInfo +-- > , resGet = Just $ do requestURI <- getRequestURI +-- > resourcePath <- getResourcePath +-- > pathInfo <- getPathInfo -- > -- uriPath requestURI == "/foo/bar/baz" -- > -- resourcePath == ["foo"] -- > -- pathInfo == ["bar", "baz"] diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs index a488aaf..5102524 100644 --- a/Network/HTTP/Lucu/Utils.hs +++ b/Network/HTTP/Lucu/Utils.hs @@ -1,6 +1,5 @@ {-# LANGUAGE - BangPatterns - , OverloadedStrings + OverloadedStrings , UnicodeSyntax #-} -- |Utility functions used internally in the Lucu httpd. These @@ -32,6 +31,7 @@ import Prelude.Unicode -- |> splitBy (== ':') "ab:c:def" -- > ==> ["ab", "c", "def"] splitBy ∷ (a → Bool) → [a] → [[a]] +{-# INLINEABLE splitBy #-} splitBy isSep src = case break isSep src of (last , [] ) → [last] diff --git a/cabal-package.mk b/cabal-package.mk index e412139..b2bf655 100644 --- a/cabal-package.mk +++ b/cabal-package.mk @@ -18,6 +18,7 @@ HPC ?= hpc DITZ ?= ditz CONFIGURE_ARGS ?= --disable-optimization +HLINT_OPTS ?= --cross --report=dist/report.html SETUP_FILE := $(wildcard Setup.*hs) CABAL_FILE := $(wildcard *.cabal) @@ -117,7 +118,7 @@ fixme: || echo 'No FIXME or THINKME found.' lint: - $(HLINT) . --cross --report + $(HLINT) . $(HLINT_OPTS) push: push-repo push-ditz push-doc diff --git a/data/Makefile b/data/Makefile index 04bd97f..c73c1f3 100644 --- a/data/Makefile +++ b/data/Makefile @@ -10,7 +10,7 @@ dist/DefaultExtensionMap.hs: mime.types compiler fi compiler: - ghc --make CompileMimeTypes -i.. -odir dist -hidir dist + ghc -Wall --make CompileMimeTypes -i.. -odir dist -hidir dist clean: rm -rf dist DefaultExtensionMap.hs CompileMimeTypes