error.txt

Site/Story.hs:71:20:
    Could not deduce (PersistMonadBackend
                        (YesodPersistBackend master (GHandler Stories master))
                      ~ Database.Persist.GenericSql.Raw.SqlBackend)
    from the context (YesodStory master)
      bound by the type signature for
                 postSectionSendR :: YesodStory master =>
                                     ChapterId -> GHandler Stories master ()
      at Site/Story.hs:65:21-82
    Expected type: PersistMonadBackend
                     (YesodPersistBackend master (GHandler Stories master))
      Actual type: PersistEntityBackend StoryAuthors
    In the second argument of `($)', namely
      `selectList [StoryAuthorsStory ==. sid] []'
    In a stmt of a 'do' block:
      aus <- runDB $ selectList [StoryAuthorsStory ==. sid] []
    In the expression:
      do { body <- runInputGet $ ireq textField "body";
           chan <- getOrCreateChannel cid =<< getYesodSub;
           (Chapter sid _ _) <- findChapter cid;
           story <- findStory sid;
           .... }

Story.hs

{-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes, TemplateHaskell, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, RecordWildCards #-}
module Site.Story where

import Prelude
import Yesod
import Yesod.Auth
import Model
import Control.Concurrent.Chan (Chan, dupChan, writeChan, newChan)
import Data.Text (Text)
import Data.Map (Map)
import Control.Monad.Trans (MonadIO)
import Network.Wai.EventSource (ServerEvent (..), eventSourceAppChan)
import Language.Haskell.TH.Syntax (Type (VarT), Pred (ClassP), mkName)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
import qualified Data.Map as M
import Control.Concurrent.STM

class (Yesod master, YesodAuth master, YesodPersist master, RenderMessage master FormMessage) => YesodStory master

mkYesodSub "Stories" [ClassP ''YesodStory [VarT $ mkName "master"]] [parseRoutes|
/ StoryIndexR GET
/new StoryNewR GET POST
/delete/#StoryId StoryDeleteR POST
/delete/#StoryId/#ChapterId ChapterDeleteR POST
/view/#StoryId StoryViewR GET
/view/#StoryId/new ChapterNewR GET POST
/view/#StoryId/chapter/#ChapterId ChapterViewR GET
/send/#ChapterId SectionSendR POST
/recv/#ChapterId SectionReceiveR GET
|]

type StoryChannel = Chan ServerEvent
newtype Stories = Stories (TVar (Map ChapterId StoryChannel))

newStories :: IO Stories
newStories = fmap Stories $ newTVarIO M.empty

getStoryIndexR :: GHandler Stories master RepHtml
getStoryIndexR = undefined

getStoryNewR :: GHandler Stories master RepHtml
getStoryNewR = undefined

postStoryNewR :: GHandler Stories master RepHtml
postStoryNewR = undefined

postStoryDeleteR :: StoryId -> GHandler Stories master RepHtml
postStoryDeleteR = undefined

postChapterDeleteR :: StoryId -> ChapterId -> GHandler Stories master RepHtml
postChapterDeleteR = undefined

getStoryViewR :: StoryId -> GHandler Stories master RepHtml
getStoryViewR = undefined

getChapterNewR :: StoryId -> GHandler Stories master RepHtml
getChapterNewR = undefined

postChapterNewR :: StoryId -> GHandler Stories master RepHtml
postChapterNewR = undefined

getChapterViewR :: StoryId -> ChapterId -> GHandler Stories master RepHtml
getChapterViewR = undefined

postSectionSendR :: (YesodStory master) => ChapterId -> GHandler Stories master ()
postSectionSendR cid = do
    body <- runInputGet $ ireq textField "body"
    chan <- getOrCreateChannel cid =<< getYesodSub
    (Chapter sid _ _) <- findChapter cid
    story <- findStory sid
    aus <- runDB $ selectList [StoryAuthorsStory ==. sid] []

    liftIO $ writeChan chan $ ServerEvent Nothing Nothing $ return $ fromText body

getSectionReceiveR :: ChapterId -> GHandler Stories master RepHtml
getSectionReceiveR = undefined

findChapter cid = runDB $ get404 cid
findStory sid = runDB $ get404 sid

canEditStory :: Story -> [StoryAuthors] -> UserId -> Bool
canEditStory Story{..} l uid = or $ (uid == storyOwner) : (map (\(StoryAuthors _ u) -> u == uid) l)

getOrCreateChannel :: (MonadIO m) => ChapterId -> Stories -> m StoryChannel
getOrCreateChannel cid (Stories t) = liftIO $ do
    nchan <- newChan
    atomically $ do
        chans <- readTVar t
        case M.lookup cid chans of
            (Just c) -> return c
            Nothing -> do
                writeTVar t $ M.insert cid nchan chans
                return nchan