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
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
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
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
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."
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
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
-- \"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.
-- \"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
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
{-# LANGUAGE
OverloadedStrings
, RecordWildCards
- , UnboxedTuples
, UnicodeSyntax
#-}
module Network.HTTP.Lucu.DefaultPage
{-# INLINE content #-}
content = A.unsafeFromByteString
<$>
- takeWhile1 (\c → ((¬) (isSPHT c)) ∧ isText c)
+ takeWhile1 (\c → (¬) (isSPHT c) ∧ isText c)
joinValues ∷ [Ascii] → Ascii
{-# INLINE joinValues #-}
{-# LANGUAGE
- BangPatterns
- , OverloadedStrings
+ OverloadedStrings
, UnicodeSyntax
#-}
-
-- |Manipulation of HTTP version string.
module Network.HTTP.Lucu.HttpVersion
( HttpVersion(..)
let addr = head addrs
bracketOnError
(socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
- (sClose)
+ sClose
(\ sock ->
do setSocketOption sock ReuseAddr 1
bindSocket sock (addrAddress addr)
--
-- * 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
printContDispo ∷ ContDispo → Ascii
printContDispo d
- = A.fromAsciiBuilder $
+ = A.fromAsciiBuilder
( A.toAsciiBuilder (A.fromCIAscii $ dType d)
⊕
printParams (dParams d) )
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
{-# LANGUAGE
- BangPatterns
- , OverloadedStrings
+ OverloadedStrings
, ScopedTypeVariables
, UnicodeSyntax
#-}
-- 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
-- |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 ()
quotedPair ∷ Parser Char
{-# INLINE quotedPair #-}
- quotedPair = char '\\' ≫ satisfy isChar
+ quotedPair = char '\\' *> satisfy isChar
-- |'qvalue' accepts a so-called qvalue.
qvalue ∷ Parser Double
, 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
-- >
-- > 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"]
{-# LANGUAGE
- BangPatterns
- , OverloadedStrings
+ OverloadedStrings
, UnicodeSyntax
#-}
-- |Utility functions used internally in the Lucu httpd. These
-- |> splitBy (== ':') "ab:c:def"
-- > ==> ["ab", "c", "def"]
splitBy ∷ (a → Bool) → [a] → [[a]]
+{-# INLINEABLE splitBy #-}
splitBy isSep src
= case break isSep src
of (last , [] ) → [last]
DITZ ?= ditz
CONFIGURE_ARGS ?= --disable-optimization
+HLINT_OPTS ?= --cross --report=dist/report.html
SETUP_FILE := $(wildcard Setup.*hs)
CABAL_FILE := $(wildcard *.cabal)
|| echo 'No FIXME or THINKME found.'
lint:
- $(HLINT) . --cross --report
+ $(HLINT) . $(HLINT_OPTS)
push: push-repo push-ditz push-doc
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
projects / Lucu.git / commitdiff