Removed reps from HasReps

Test/QuasiResource.hs

@@ -12,19 +12,19 @@ import Data.List
 
 data MyYesod = MyYesod
 
-instance Show (Handler MyYesod RepChooser) where show _ = "Another handler"
+instance Show (Handler MyYesod ChooseRep) where show _ = "Another handler"
 
 getStatic :: Verb -> [String] -> Handler MyYesod HtmlObject
 getStatic v p = return $ toHtmlObject ["getStatic", show v, show p]
 pageIndex :: Handler MyYesod HtmlObject
 pageIndex = return $ toHtmlObject ["pageIndex"]
-pageAdd :: Handler MyYesod RepChooser
+pageAdd :: Handler MyYesod ChooseRep
 pageAdd = return $ chooseRep $ toHtmlObject ["pageAdd"]
-pageDetail :: String -> Handler MyYesod RepChooser
+pageDetail :: String -> Handler MyYesod ChooseRep
 pageDetail s = return $ chooseRep $ toHtmlObject ["pageDetail", s]
 pageDelete :: String -> Handler MyYesod HtmlObject
 pageDelete s = return $ toHtmlObject ["pageDelete", s]
-pageUpdate :: String -> Handler MyYesod RepChooser
+pageUpdate :: String -> Handler MyYesod ChooseRep
 pageUpdate s = return $ chooseRep $ toHtmlObject ["pageUpdate", s]
 userInfo :: Int -> Handler MyYesod HtmlObject
 userInfo i = return $ toHtmlObject ["userInfo", show i]
@@ -33,11 +33,11 @@ userVariable i s = return $ toHtmlObject ["userVariable", show i, s]
 userPage :: Int -> [String] -> Handler MyYesod HtmlObject
 userPage i p = return $ toHtmlObject ["userPage", show i, show p]
 
-instance Show (Verb -> Handler MyYesod RepChooser) where
+instance Show (Verb -> Handler MyYesod ChooseRep) where
     show _ = "verb -> handler"
-instance Show (Resource -> Verb -> Handler MyYesod RepChooser) where
+instance Show (Resource -> Verb -> Handler MyYesod ChooseRep) where
     show _ = "resource -> verb -> handler"
-handler :: Resource -> Verb -> Handler MyYesod RepChooser
+handler :: Resource -> Verb -> Handler MyYesod ChooseRep
 handler = [$resources|
 /static/*filepath/: getStatic
 /page/:
@@ -55,7 +55,7 @@ handler = [$resources|
     Get: userPage
 |]
 
-ph :: [String] -> Handler MyYesod RepChooser -> Assertion
+ph :: [String] -> Handler MyYesod ChooseRep -> Assertion
 ph ss h = do
     let eh = return . chooseRep . toHtmlObject . show
         rr = error "No raw request"

Yesod/Handler.hs

@@ -95,8 +95,8 @@ getYesod = Handler $ \(_, yesod, _) -> return ([], HCContent yesod)
 instance HasTemplateGroup (Handler yesod) where
     getTemplateGroup = Handler $ \(_, _, tg) -> return ([], HCContent tg)
 
-runHandler :: Handler yesod RepChooser
-           -> (ErrorResponse -> Handler yesod RepChooser)
+runHandler :: Handler yesod ChooseRep
+           -> (ErrorResponse -> Handler yesod ChooseRep)
            -> RawRequest
            -> yesod
            -> TemplateGroup
@@ -124,7 +124,7 @@ runHandler (Handler handler) eh rr y tg cts = do
             (ct, c) <- a cts
             return $ Response 200 headers ct c
 
-safeEh :: ErrorResponse -> Handler yesod RepChooser
+safeEh :: ErrorResponse -> Handler yesod ChooseRep
 safeEh er = do
     liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
     return $ chooseRep $ toHtmlObject "Internal server error"

Yesod/Helpers/AtomFeed.hs

@@ -40,7 +40,7 @@ data AtomFeed = AtomFeed
     , atomEntries :: [AtomFeedEntry]
     }
 instance HasReps AtomFeedResponse where
-    reps =
+    chooseRep = defChooseRep
         [ (TypeAtom, return . cs)
         ]
 

Yesod/Helpers/Auth.hs

@@ -65,10 +65,10 @@ data AuthResource =
     | LoginRpxnow
     deriving (Show, Eq, Enum, Bounded)
 
-rc :: HasReps x => Handler y x -> Handler y RepChooser
+rc :: HasReps x => Handler y x -> Handler y ChooseRep
 rc = fmap chooseRep
 
-authHandler :: YesodAuth y => Verb -> [String] -> Handler y RepChooser
+authHandler :: YesodAuth y => Verb -> [String] -> Handler y ChooseRep
 authHandler Get ["check"] = rc authCheck
 authHandler Get ["logout"] = rc authLogout
 authHandler Get ["openid"] = rc authOpenidForm

Yesod/Helpers/Sitemap.hs

@@ -69,7 +69,7 @@ instance ConvertSuccess SitemapResponse Html where
                     ]
 
 instance HasReps SitemapResponse where
-    reps =
+    chooseRep = defChooseRep
         [ (TypeXml, return . cs)
         ]
 

Yesod/Rep.hs

@@ -27,9 +27,9 @@
 -- effort.
 module Yesod.Rep
     ( Content (..)
-    , RepChooser
-    , ContentPair
+    , ChooseRep
     , HasReps (..)
+    , defChooseRep
       -- * Specific types of representations
     , Plain (..)
     , plain
@@ -77,38 +77,36 @@ instance ConvertSuccess HtmlDoc Content where
 instance ConvertSuccess XmlDoc Content where
     convertSuccess = cs . unXmlDoc
 
-type ContentPair = (ContentType, Content)
-type RepChooser = [ContentType] -> IO ContentPair
+type ChooseRep = [ContentType] -> IO (ContentType, Content)
 
 -- | Any type which can be converted to representations. There must be at least
 -- one representation for each type.
 class HasReps a where
-    reps :: [(ContentType, a -> IO Content)]
-    chooseRep :: a -> RepChooser
-    chooseRep a ts = do
-      let (ct, c) =
-            case mapMaybe helper ts of
-                (x:_) -> x
-                [] -> case reps of
-                        [] -> error "Empty reps"
-                        (x:_) -> x
-      c' <- c a
-      return (ct, c')
-            where
-                --helper :: ContentType -> Maybe ContentPair
-                helper ct = do
-                    c <- lookup ct reps
-                    return (ct, c)
+    chooseRep :: a -> ChooseRep
 
-instance HasReps RepChooser where
-    reps = error "reps of RepChooser"
+-- | A helper method for generating 'HasReps' instances.
+defChooseRep :: [(ContentType, a -> IO Content)] -> a -> ChooseRep
+defChooseRep reps a ts = do
+  let (ct, c) =
+        case mapMaybe helper ts of
+            (x:_) -> x
+            [] -> case reps of
+                    [] -> error "Empty reps"
+                    (x:_) -> x
+  c' <- c a
+  return (ct, c')
+        where
+            helper ct = do
+                c <- lookup ct reps
+                return (ct, c)
+
+instance HasReps ChooseRep where
     chooseRep = id
 
 instance HasReps () where
-    reps = [(TypePlain, const $ return $ cs "")]
+    chooseRep = defChooseRep [(TypePlain, const $ return $ cs "")]
 
 instance HasReps [(ContentType, Content)] where
-    reps = error "reps of [(ContentType, Content)]"
     chooseRep a cts = return $
         case filter (\(ct, _) -> ct `elem` cts) a of
             ((ct, c):_) -> (ct, c)
@@ -119,7 +117,7 @@ instance HasReps [(ContentType, Content)] where
 newtype Plain = Plain { unPlain :: Text }
     deriving (Eq, Show)
 instance HasReps Plain where
-    reps = [(TypePlain, return . cs . unPlain)]
+    chooseRep = defChooseRep [(TypePlain, return . cs . unPlain)]
 
 plain :: ConvertSuccess x Text => x -> Plain
 plain = Plain . cs
@@ -129,7 +127,7 @@ data Template = Template (StringTemplate Text)
                          HtmlObject
                          (IO [(String, HtmlObject)])
 instance HasReps Template where
-    reps = [ (TypeHtml,
+    chooseRep = defChooseRep [ (TypeHtml,
               \(Template t name ho attrsIO) -> do
                 attrs <- attrsIO
                 return
@@ -144,7 +142,7 @@ instance HasReps Template where
 -- FIXME
 data TemplateFile = TemplateFile FilePath HtmlObject
 instance HasReps TemplateFile where
-    reps = [ (TypeHtml,
+    chooseRep = defChooseRep [ (TypeHtml,
               \(TemplateFile fp h) -> do
                     contents <- readFile fp
                     let t = newSTMP contents
@@ -156,19 +154,17 @@ instance HasReps TemplateFile where
 
 data Static = Static ContentType ByteString
 instance HasReps Static where
-    reps = error "reps of Static"
     chooseRep (Static ct bs) _ = return (ct, Content $ const $ return bs)
 
 data StaticFile = StaticFile ContentType FilePath
 instance HasReps StaticFile where
-    reps = error "reps of StaticFile"
     chooseRep (StaticFile ct fp) _ = do
         bs <- BL.readFile fp
         return (ct, Content $ const $ return bs)
 
 -- Useful instances of HasReps
 instance HasReps HtmlObject where
-    reps =
+    chooseRep = defChooseRep
         [ (TypeHtml, return . cs . unHtmlDoc . cs)
         , (TypeJson, return . cs . unJsonDoc . cs)
         ]

Yesod/Yesod.hs

@@ -30,7 +30,7 @@ import Hack.Middleware.MethodOverride
 class Yesod a where
     -- | Please use the Quasi-Quoter, you\'ll be happier. For more information,
     -- see the examples/fact.lhs sample.
-    handlers :: Resource -> Verb -> Handler a RepChooser
+    handlers :: Resource -> Verb -> Handler a ChooseRep
 
     -- | The encryption key to be used for encrypting client sessions.
     encryptKey :: a -> IO Word256
@@ -42,7 +42,7 @@ class Yesod a where
     clientSessionDuration = const 120
 
     -- | Output error response pages.
-    errorHandler :: ErrorResponse -> Handler a RepChooser
+    errorHandler :: ErrorResponse -> Handler a ChooseRep
     errorHandler = defaultErrorHandler
 
     -- | The template directory. Blank means no templates.
@@ -58,7 +58,7 @@ getApproot = approot `fmap` getYesod
 
 defaultErrorHandler :: Yesod y
                     => ErrorResponse
-                    -> Handler y RepChooser
+                    -> Handler y ChooseRep
 defaultErrorHandler NotFound = do
     rr <- getRawRequest
     return $ chooseRep $ toHtmlObject $ "Not found: " ++ show rr