From 1a997621e82be69397af93d2d98f7d08c7c1c51f Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 5 Oct 2009 06:23:10 +0200 Subject: [PATCH] hlinted --- Web/Restful/Application.hs | 4 +-- Web/Restful/Handler.hs | 7 +++--- Web/Restful/Helpers/Auth.hs | 14 +++++------ Web/Restful/Request.hs | 3 +-- Web/Restful/Resource.hs | 43 ++++++++++++++++----------------- Web/Restful/Response/Sitemap.hs | 2 +- Web/Restful/Utils.hs | 12 ++++----- 7 files changed, 41 insertions(+), 44 deletions(-) diff --git a/Web/Restful/Application.hs b/Web/Restful/Application.hs index 035101ce..0fe3dbcd 100644 --- a/Web/Restful/Application.hs +++ b/Web/Restful/Application.hs @@ -73,12 +73,12 @@ class ResourceName a b => RestfulApp a b | a -> b where errorHandler _ _ (InternalError e) = reps $ toObject $ "Internal server error: " ++ e errorHandler _ _ (InvalidArgs ia) = - reps $ toObject $ + reps $ toObject [ ("errorMsg", toObject "Invalid arguments") , ("messages", toObject ia) ] errorHandler _ _ PermissionDenied = - reps $ toObject $ "Permission denied" + reps $ toObject "Permission denied" -- | Given a sample resource name (purely for typing reasons), generating -- a Hack application. diff --git a/Web/Restful/Handler.hs b/Web/Restful/Handler.hs index 043fb109..847928ee 100644 --- a/Web/Restful/Handler.hs +++ b/Web/Restful/Handler.hs @@ -1,6 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} --------------------------------------------------------- @@ -77,7 +76,7 @@ chooseRep :: Monad m -> [ContentType] -> m (ContentType, B.ByteString) chooseRep rs cs - | length rs == 0 = fail "All reps must have at least one value" + | null rs = fail "All reps must have at least one representation" | otherwise = do let availCs = map fst rs case filter (`elem` availCs) cs of @@ -137,7 +136,7 @@ addCookie :: Monad m -> String -- ^ key -> String -- ^ value -> HandlerT m () -addCookie a b c = addHeader $ AddCookie a b c +addCookie a b = addHeader . AddCookie a b -- | Unset the cookie on the client. deleteCookie :: Monad m => String -> HandlerT m () @@ -145,7 +144,7 @@ deleteCookie = addHeader . DeleteCookie -- | Set an arbitrary header on the client. header :: Monad m => String -> String -> HandlerT m () -header a b = addHeader $ Header a b +header a = addHeader . Header a addHeader :: Monad m => Header -> HandlerT m () addHeader h = HandlerT (const $ return (Right (), [h])) diff --git a/Web/Restful/Helpers/Auth.hs b/Web/Restful/Helpers/Auth.hs index 83c909ca..272fc656 100644 --- a/Web/Restful/Helpers/Auth.hs +++ b/Web/Restful/Helpers/Auth.hs @@ -42,13 +42,13 @@ data AuthResource = instance Enumerable AuthResource where enumerate = - Check - : Logout - : Openid - : OpenidForward - : OpenidComplete - : LoginRpxnow - : [] + [ Check + , Logout + , Openid + , OpenidForward + , OpenidComplete + , LoginRpxnow + ] type RpxnowApiKey = String -- FIXME newtype instance ResourceName AuthResource (Maybe RpxnowApiKey) where diff --git a/Web/Restful/Request.hs b/Web/Restful/Request.hs index 610126cc..2d77324a 100644 --- a/Web/Restful/Request.hs +++ b/Web/Restful/Request.hs @@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE OverlappingInstances #-} -{-# LANGUAGE StandaloneDeriving #-} --------------------------------------------------------- -- -- Module : Web.Restful.Request @@ -254,7 +253,7 @@ cookies rr name = map snd . filter (fst `equals` name) . rawCookies $ rr instance Parameter a => Parameter (Maybe a) where readParams [] = Right Nothing - readParams [x] = readParam x >>= return . Just + readParams [x] = Just `fmap` readParam x readParams xs = Left $ "Given " ++ show (length xs) ++ " values, expecting 0 or 1" diff --git a/Web/Restful/Resource.hs b/Web/Restful/Resource.hs index 5c47dc34..05677ae7 100644 --- a/Web/Restful/Resource.hs +++ b/Web/Restful/Resource.hs @@ -31,6 +31,7 @@ import Web.Restful.Definitions import Web.Restful.Handler import Data.List (intercalate) import Data.Enumerable +import Control.Monad (replicateM) import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit @@ -82,14 +83,14 @@ type SMap = [(String, String)] data CheckPatternReturn = StaticMatch | DynamicMatch (String, String) | NoMatch checkPattern :: ResourcePattern -> Resource -> Maybe SMap -checkPattern rp r = checkPattern'' (unRP rp) r +checkPattern = checkPatternPieces . unRP -checkPattern'' :: [ResourcePatternPiece] -> Resource -> Maybe SMap -checkPattern'' rp r - | length rp /= 0 && isSlurp (last rp) = do +checkPatternPieces :: [ResourcePatternPiece] -> Resource -> Maybe SMap +checkPatternPieces rp r + | not (null rp) && isSlurp (last rp) = do let rp' = init rp (r1, r2) = splitAt (length rp') r - smap <- checkPattern'' rp' r1 + smap <- checkPatternPieces rp' r1 let slurpValue = intercalate "/" r2 Slurp slurpKey = last rp return $ (slurpKey, slurpValue) : smap @@ -133,35 +134,33 @@ validatePatterns (x:xs) = validatePatterns' :: ResourcePattern -> ResourcePattern -> [(ResourcePattern, ResourcePattern)] - validatePatterns' a b = - if overlaps (unRP a) (unRP b) - then [(a, b)] - else [] + validatePatterns' a b = [(a, b) | overlaps (unRP a) (unRP b)] + ---- Testing testSuite :: Test testSuite = testGroup "Web.Restful.Resource" - [ testCase "non-overlap" case_overlap1 - , testCase "overlap" case_overlap2 - , testCase "overlap-slurp" case_overlap3 - , testCase "validatePatterns" case_validatePatterns + [ testCase "non-overlap" caseOverlap1 + , testCase "overlap" caseOverlap2 + , testCase "overlap-slurp" caseOverlap3 + , testCase "validatePatterns" caseValidatePatterns , testProperty "show pattern" prop_showPattern ] -case_overlap1 :: Assertion -case_overlap1 = assert $ not $ overlaps +caseOverlap1 :: Assertion +caseOverlap1 = assert $ not $ overlaps (unRP $ fromString "/foo/$bar/") (unRP $ fromString "/foo/baz/$bin") -case_overlap2 :: Assertion -case_overlap2 = assert $ overlaps +caseOverlap2 :: Assertion +caseOverlap2 = assert $ overlaps (unRP $ fromString "/foo/bar") (unRP $ fromString "/foo/$baz") -case_overlap3 :: Assertion -case_overlap3 = assert $ overlaps +caseOverlap3 :: Assertion +caseOverlap3 = assert $ overlaps (unRP $ fromString "/foo/bar/baz/$bin") (unRP $ fromString "*slurp") -case_validatePatterns :: Assertion -case_validatePatterns = +caseValidatePatterns :: Assertion +caseValidatePatterns = let p1 = fromString "/foo/bar/baz" p2 = fromString "/foo/$bar/baz" p3 = fromString "/bin" @@ -179,6 +178,6 @@ instance Arbitrary ResourcePatternPiece where arbitrary = do constr <- elements [Static, Dynamic, Slurp] size <- elements [1..10] - s <- sequence (replicate size $ elements ['a'..'z']) + s <- replicateM size $ elements ['a'..'z'] return $ constr s coarbitrary = undefined diff --git a/Web/Restful/Response/Sitemap.hs b/Web/Restful/Response/Sitemap.hs index 40334a6c..fd86adde 100644 --- a/Web/Restful/Response/Sitemap.hs +++ b/Web/Restful/Response/Sitemap.hs @@ -62,7 +62,7 @@ instance Show SitemapResponse where prefix = "http://" ++ host ++ case port of 80 -> "" - _ -> ":" ++ show port + _ -> ':' : show port helper (SitemapUrl loc modTime freq pri) = concat [ "" , encodeHtml $ showLoc loc diff --git a/Web/Restful/Utils.hs b/Web/Restful/Utils.hs index 19053d68..e4a43309 100644 --- a/Web/Restful/Utils.hs +++ b/Web/Restful/Utils.hs @@ -41,12 +41,12 @@ tryLookup def key = fromMaybe def . lookup key ----- Testing testSuite :: Test testSuite = testGroup "Web.Restful.Response" - [ testCase "tryLookup1" test_tryLookup1 - , testCase "tryLookup2" test_tryLookup2 + [ testCase "tryLookup1" caseTryLookup1 + , testCase "tryLookup2" caseTryLookup2 ] -test_tryLookup1 :: Assertion -test_tryLookup1 = tryLookup "default" "foo" [] @?= "default" +caseTryLookup1 :: Assertion +caseTryLookup1 = tryLookup "default" "foo" [] @?= "default" -test_tryLookup2 :: Assertion -test_tryLookup2 = tryLookup "default" "foo" [("foo", "baz")] @?= "baz" +caseTryLookup2 :: Assertion +caseTryLookup2 = tryLookup "default" "foo" [("foo", "baz")] @?= "baz"