Permalink
Browse files

Nice transactions. No more gratuitous runDB in model. Monad stacks yay

  • Loading branch information...
1 parent 2b2da6f commit d82ff291be28ef1783c81e5b0c899803bf4fd856 @samstokes committed Sep 12, 2011
Showing with 6 additions and 5 deletions.
  1. +1 −1 Handler/Root.hs
  2. +5 −4 Model.hs
View
@@ -73,7 +73,7 @@ postTasksR = maybeAuthId >>= postTasksR' where
((result, taskWidget), _) <- runFormPost taskForm
case result of
FormSuccess task -> do
- createTaskAtBottom userId task
+ runDB $ createTaskAtBottom userId task
redirectTemporary TasksR
_ -> undefined -- TODO
View
@@ -1,9 +1,10 @@
-{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell, GADTs, OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell, GADTs, OverloadedStrings, FlexibleContexts #-}
module Model where
import Yesod
import Data.String (IsString)
import Data.Text (Text)
+import Database.Persist.GenericSql.Raw (SqlPersist)
import Text.Blaze (ToHtml)
@@ -23,11 +24,11 @@ data NewTask = NewTask { newTaskTitle :: Text } deriving (Show)
newTask :: UserId -> Int -> NewTask -> Task
newTask uid order (NewTask title) = Task uid title 0 False order
-
+createTaskAtBottom :: PersistBackend SqlPersist m => UserId -> NewTask -> SqlPersist m TaskId
createTaskAtBottom userId task = do
- maybeLastTask <- runDB $ selectFirst [TaskUser ==. userId] [Desc TaskOrder]
+ maybeLastTask <- selectFirst [TaskUser ==. userId] [Desc TaskOrder]
let lastOrder = maybe 0 (taskOrder . snd) maybeLastTask
- runDB $ insert $ newTask userId (succ lastOrder) task
+ insert $ newTask userId (succ lastOrder) task
taskState :: Task -> TaskState
taskState task = if taskDone task then "done" else "pending"

0 comments on commit d82ff29

Please sign in to comment.