does not work well

yesod and persisten

{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}
{-# LANGUAGE GADTs, FlexibleContexts #-}

import Yesod
import Database.Persist
import Database.Persist.TH
import Database.Persist.Sqlite
import Control.Monad.IO.Class (liftIO)
import Control.Applicative ((<$>), (<*>))
import Data.Text

data Inject = Inject ConnectionPool

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Lesson
  count Int INC DEC
  lid Int
  UniqueId lid
|]

instance YesodPersist Inject where
    type YesodPersistBackend Inject = SqlPersist

    runDB action = do
        Inject pool <- getYesod
        runSqlPool action pool


mkYesod "Inject" [parseRoutes|
/ RootR GET
/insert InsertR POST
|]
instance Yesod Inject

instance RenderMessage Inject FormMessage where
    renderMessage _ _ = defaultFormMessage

getRootR :: Handler RepHtml
getRootR = hamletToRepHtml [hamlet|
<form method=post action=@{InsertR}>
  Lesson
  <input type=text name=lid>
  Count
  <input type=text name=count>
  <input type=submit>
|]

postInsertR :: Handler RepPlain
postInsertR = do
    (count, lid) <- runInputPost $ (,) <$> ireq intField "count" <*> ireq intField "lid"
    all <- runDB (action count lid)
    return $ RepPlain $ toContent $ show all
  where
    action count lid = do
        newId <- insert $ Lesson count lid
        all <- selectList [LessonLid !=. 0] []
        liftIO $ print all
        liftIO $ print "Why"
        commit

main :: IO ()
main = withSqlitePool "testDB" 2 $ \pool -> do
    runSqlPool (runMigration migrateAll) pool
    warp  3002 (Inject pool)