From 2bcf36a739341aaaf56d812286d57233fff81ad5 Mon Sep 17 00:00:00 2001 From: PHO Date: Thu, 17 Nov 2011 07:53:55 +0900 Subject: [PATCH] hlint --- ImplantFile.hs | 2 +- Network/HTTP/Lucu/Config.hs | 3 ++- Network/HTTP/Lucu/DefaultPage.hs | 8 ++++---- Network/HTTP/Lucu/Headers.hs | 4 ++-- Network/HTTP/Lucu/Httpd.hs | 5 +++-- Network/HTTP/Lucu/Implant/Rewrite.hs | 6 ++---- Network/HTTP/Lucu/MIMEType/Guess.hs | 2 +- Network/HTTP/Lucu/OrphanInstances.hs | 11 ++++++----- Network/HTTP/Lucu/Parser/Http.hs | 2 +- Network/HTTP/Lucu/Utils.hs | 7 +++---- 10 files changed, 25 insertions(+), 25 deletions(-) diff --git a/ImplantFile.hs b/ImplantFile.hs index bd01923..60f9b54 100644 --- a/ImplantFile.hs +++ b/ImplantFile.hs @@ -179,7 +179,7 @@ generateHaskellSource opts srcFile = do i ← openInput srcFile (getMIMEType opts) (getETag opts) o ← openOutput opts doc ← pprInput i modName symName - hPutStrLn o $ show $ to_HPJ_Doc doc + hPutStrLn o ∘ show $ to_HPJ_Doc doc hClose o where modName ∷ ModName diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs index 5e7246e..80845bd 100644 --- a/Network/HTTP/Lucu/Config.hs +++ b/Network/HTTP/Lucu/Config.hs @@ -24,6 +24,7 @@ import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap #if defined(HAVE_SSL) import OpenSSL.Session #endif +import Prelude.Unicode import System.IO.Unsafe -- |Configuration record for to run the httpd. @@ -107,7 +108,7 @@ data SSLConfig defaultConfig ∷ Config defaultConfig = Config { cnfServerSoftware = "Lucu/1.0" - , cnfServerHost = CI.mk $ T.pack $ unsafePerformIO getHostName + , cnfServerHost = CI.mk ∘ T.pack $ unsafePerformIO getHostName , cnfServerPort = "http" , cnfServerV4Addr = Just "0.0.0.0" , cnfServerV6Addr = Just "::" diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs index 076ad10..0fefa7f 100644 --- a/Network/HTTP/Lucu/DefaultPage.hs +++ b/Network/HTTP/Lucu/DefaultPage.hs @@ -54,10 +54,10 @@ mkDefaultPage ∷ (ArrowXml (⇝), StatusCode sc) → b ⇝ XmlTree {-# INLINEABLE mkDefaultPage #-} mkDefaultPage conf status msgA - = let sStr = A.toString $ A.fromAsciiBuilder $ printStatusCode status + = let sStr = A.toString ∘ A.fromAsciiBuilder $ printStatusCode status sig = concat [ A.toString (cnfServerSoftware conf) , " at " - , T.unpack $ CI.original $ cnfServerHost conf + , T.unpack ∘ CI.original $ cnfServerHost conf ] in ( eelem "/" += ( eelem "html" @@ -138,7 +138,7 @@ getMsg req res@(Response {..}) = none where path ∷ String - path = uriPath $ reqURI $ fromJust req + path = uriPath ∘ reqURI $ fromJust req loc ∷ String - loc = A.toString $ fromJust $ getHeader "Location" res + loc = A.toString ∘ fromJust $ getHeader "Location" res diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index 0d53d31..e413eb2 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -229,11 +229,11 @@ headers = do xs ← P.many header joinValues = A.fromAsciiBuilder ∘ mconcat ∘ intersperse (A.toAsciiBuilder "\x20") - ∘ map A.toAsciiBuilder + ∘ (A.toAsciiBuilder <$>) printHeaders ∷ Headers → AsciiBuilder printHeaders (Headers m) - = mconcat (map printHeader (fromFoldable m)) ⊕ + = mconcat (printHeader <$> fromFoldable m) ⊕ A.toAsciiBuilder "\x0D\x0A" where printHeader ∷ (CIAscii, Ascii) → AsciiBuilder diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index 3f2d733..c127250 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -21,6 +21,7 @@ import Network.HTTP.Lucu.RequestReader import Network.HTTP.Lucu.Resource.Tree import Network.HTTP.Lucu.ResponseWriter import Network.HTTP.Lucu.SocketLike as SL +import Prelude.Unicode -- |This is the entry point of Lucu httpd. It listens to a socket and -- waits for clients. 'runHttpd' never stops by itself so the only way @@ -76,8 +77,8 @@ runHttpd cnf tree fbs launchListener so = do p ← SL.socketPort so -- FIXME: Don't throw away the thread ID as we can't - -- kill it later then. [1] - void $ forkIO $ httpLoop p so + -- kill it later then. + void ∘ forkIO $ httpLoop p so listenOn ∷ Family → HostName → ServiceName → IO Socket listenOn fam host srv diff --git a/Network/HTTP/Lucu/Implant/Rewrite.hs b/Network/HTTP/Lucu/Implant/Rewrite.hs index affa897..9ed1d8d 100644 --- a/Network/HTTP/Lucu/Implant/Rewrite.hs +++ b/Network/HTTP/Lucu/Implant/Rewrite.hs @@ -171,8 +171,7 @@ qualifyAll m a unqualify ∷ Name → String → RewriteRule unqualify (Name o _) m = let pat = NamePat Nothing (Just o) - iop = UnqualifiedImp (mkModName m) - $ Just + iop = UnqualifiedImp (mkModName m) ∘ Just $ singleton (VarName, o) in RewriteRule pat Unqualify (singleton iop) @@ -183,8 +182,7 @@ unqualify (Name o _) m unqualifyIn ∷ Name → Name → String → RewriteRule unqualifyIn (Name name _) (Name tycl _) m = let pat = NamePat Nothing (Just name) - iop = UnqualifiedImp (mkModName m) - $ Just + iop = UnqualifiedImp (mkModName m) ∘ Just $ singleton (TcClsName, tycl) in RewriteRule pat Unqualify (singleton iop) diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs index 7c3c64d..d77c976 100644 --- a/Network/HTTP/Lucu/MIMEType/Guess.hs +++ b/Network/HTTP/Lucu/MIMEType/Guess.hs @@ -117,7 +117,7 @@ parseExtMap src "linebreak" compile ∷ Ord k ⇒ [(v, [k])] → Either (k, v, v) (Map k v) -compile = go (∅) ∘ concat ∘ map tr +compile = go (∅) ∘ concat ∘ (tr <$>) where tr ∷ (v, [k]) → [(k, v)] tr (v, ks) = [(k, v) | k ← ks] diff --git a/Network/HTTP/Lucu/OrphanInstances.hs b/Network/HTTP/Lucu/OrphanInstances.hs index b0bd421..47db98b 100644 --- a/Network/HTTP/Lucu/OrphanInstances.hs +++ b/Network/HTTP/Lucu/OrphanInstances.hs @@ -12,6 +12,7 @@ module Network.HTTP.Lucu.OrphanInstances ( ) where +import Control.Applicative hiding (empty) import Data.Ascii (Ascii) import qualified Data.Ascii as A import Data.ByteString (ByteString) @@ -31,7 +32,7 @@ import Prelude hiding (last, mapM, null, reverse) import Prelude.Unicode instance Lift ByteString where - lift bs = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |] + lift bs = [| Strict.pack $(litE ∘ stringL $ Strict.unpack bs) |] instance Lift Lazy.ByteString where lift = Lazy.foldrChunks f [| Lazy.Empty |] @@ -46,14 +47,14 @@ instance (Lift s, FoldCase s) ⇒ Lift (CI s) where lift s = [| CI.mk $(lift $ CI.original s) |] instance Lift Text where - lift t = [| T.pack $(litE $ stringL $ T.unpack t) |] + lift t = [| T.pack $(litE ∘ stringL $ T.unpack t) |] instance (Lift k, Lift v, Collection c (k, v)) ⇒ Lift c where lift c | null c = [| empty |] | otherwise = [| fromList $(liftPairs (fromFoldable c)) |] where - liftPairs = listE ∘ map liftPair + liftPairs = listE ∘ (liftPair <$>) liftPair (k, v) = tupE [lift k, lift v] instance Lift UTCTime where @@ -68,5 +69,5 @@ instance Lift DiffTime where lift dt = [| fromRational ($n % $d) ∷ DiffTime |] where n, d ∷ Q Exp - n = lift $ numerator $ toRational dt - d = lift $ denominator $ toRational dt + n = lift ∘ numerator $ toRational dt + d = lift ∘ denominator $ toRational dt diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs index 72d8ca1..e59f460 100644 --- a/Network/HTTP/Lucu/Parser/Http.hs +++ b/Network/HTTP/Lucu/Parser/Http.hs @@ -128,7 +128,7 @@ quotedStr ∷ Parser Ascii quotedStr = do void $ char '"' xs ← P.many (qdtext <|> quotedPair) void $ char '"' - return $ A.unsafeFromByteString $ BS.pack xs + return ∘ A.unsafeFromByteString $ BS.pack xs "quotedStr" where diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs index 8722ecb..bfa2acf 100644 --- a/Network/HTTP/Lucu/Utils.hs +++ b/Network/HTTP/Lucu/Utils.hs @@ -86,7 +86,7 @@ parseWWWFormURLEncoded src ) where unescape ∷ String → ByteString - unescape = Strict.pack ∘ unEscapeString ∘ map plusToSpace + unescape = Strict.pack ∘ unEscapeString ∘ (plusToSpace <$>) plusToSpace ∷ Char → Char plusToSpace '+' = ' ' @@ -99,7 +99,7 @@ splitPathInfo uri = let reqPathStr = uriPath uri reqPath = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)] in - map Strict.pack reqPath + Strict.pack <$> reqPath -- |>>> trim " ab c d " -- "ab c d" @@ -142,6 +142,5 @@ getLastModified = (clockTimeToUTC <$>) ∘ getModificationTime where clockTimeToUTC ∷ ClockTime → UTCTime clockTimeToUTC (TOD sec picoSec) - = posixSecondsToUTCTime - $ fromRational + = posixSecondsToUTCTime ∘ fromRational $ sec % 1 + picoSec % (1000 ⋅ 1000 ⋅ 1000 ⋅ 1000) -- 2.40.0