MonadState / MonadIO errors

Ticket.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Scorch.Acid.Ticket
       (
         Tickets
       , Ticket
       , allTicketBatches
       , insertKey
       , lookupKey
       , deleteKey
       ) where

import           Control.Applicative
import           Control.Monad.Trans (liftIO)
import           Control.Monad.State
import           Control.Monad.Reader
import           Data.Typeable
import           Data.SafeCopy (base, deriveSafeCopy)
import qualified Data.UUID as UUID
import           Data.UUID.V4
import qualified Data.Map as Map
import           Snap.Snaplet.AcidState

data Ticket = Ticket {
    label :: String
  , imageSrc :: String
  } deriving (Show, Typeable)

deriveSafeCopy 0 'base ''Ticket

data Tickets = Tickets !(Map.Map String Ticket)
  deriving (Show, Typeable)

deriveSafeCopy 0 'base ''Tickets

allTickets :: Query Tickets [(String, Ticket)]
allTickets = do
  Tickets m <- get
  return $ Map.toList m
  
insert :: Ticket -> Update Tickets ()
insert v = do
  Tickets m <- get
  xid <- liftIO $ nextRandom
  put $ Tickets $ Map.insert (UUID.toString xid) v m

lookupKey :: String -> Query Tickets (Maybe Ticket)
lookupKey xid = do
  Tickets m <- ask
  return (Map.lookup xid m)

deleteKey :: String -> Update Tickets ()
deleteKey xid = do
  Tickets m <- ask
  put $ Tickets $ Map.delete xid m

makeAcidic ''Tickets ['allTickets, 'insert, 'lookupKey, 'deleteKey]