Pārlūkot izejas kodu

Update the Opaleye example so it is polymorphic, demonstrating CanOpaleye

master
Peter J. Jones pirms 3 mēnešiem
vecāks
revīzija
8260619ad7
Parakstījis: Peter Jones <pjones@devalot.com> GPG atslēgas ID: 9DAFAA8D01941E49
2 mainītis faili ar 28 papildinājumiem un 26 dzēšanām
  1. 10
    14
      opaleye/example/Main.hs
  2. 18
    12
      opaleye/src/Iolaus/Opaleye.hs

+ 10
- 14
opaleye/example/Main.hs Parādīt failu

@@ -106,10 +106,8 @@ people = table "people" (pPerson

--------------------------------------------------------------------------------
-- | Insert a new person into the database.
createNewPerson :: App ()
createNewPerson = do
fn <- Text.pack <$> liftIO (putStr "Enter your given/first name: " >> getLine)
ln <- Text.pack <$> liftIO (putStr "And now your family/last name: " >> getLine)
createNewPerson :: (DB.CanOpaleye m) => Text -> Text -> m ()
createNewPerson fn ln = do

let p = Person (C.constant fn) (C.constant ln)
_ <- DB.liftQuery (DB.insert $ O.Insert people [p] O.rCount Nothing)
@@ -118,14 +116,8 @@ createNewPerson = do
--------------------------------------------------------------------------------
-- | Example running a database SELECT from within our app's
-- transformer stack.
printEveryone :: App ()
printEveryone = do
ps <- DB.liftQuery (DB.select $ selectTable people)
mapM_ printPerson ps

where
printPerson :: Person' Text -> App ()
printPerson = liftIO . print
fetchEveryone :: (DB.CanOpaleye m) => m [Person' Text]
fetchEveryone = DB.liftQuery (DB.select $ selectTable people)

--------------------------------------------------------------------------------
-- | Unwind the transformer stack and get back to IO.
@@ -159,8 +151,12 @@ main = do
result <- runApp (AppEnv opaleye "Something") $ do
schemaDir <- (</> "example" </> "schema") <$> liftIO getDataDir
DB.migrate schemaDir True
createNewPerson
printEveryone

fn <- Text.pack <$> liftIO (putStr "Enter your given/first name: " >> getLine)
ln <- Text.pack <$> liftIO (putStr "And now your family/last name: " >> getLine)

createNewPerson fn ln
fetchEveryone >>= mapM_ (liftIO . print)

-- Print out the result (which should be @Right ()@) and the EKG store:
print result

+ 18
- 12
opaleye/src/Iolaus/Opaleye.hs Parādīt failu

@@ -71,6 +71,7 @@ module Iolaus.Opaleye
-- The 'PostgreSQL.SqlError' exception will be caught and turned
-- into a 'MonadError' error.
, CanOpaleye(..)
, MonadOpaleye

-- * Reader Environment
, initOpaleye
@@ -171,23 +172,31 @@ newtype Query a = Query
)

--------------------------------------------------------------------------------
-- | A constraint alias to make typing shorter.
--
class CanOpaleye m where
-- If your application's monad implements these classes plus 'MonadIO'
-- it will automatically be an instance of 'CanOpaleye'.
type MonadOpaleye e r m =
( MonadError e m
, AsOpaleyeError e
, MonadReader r m
, HasOpaleye r
)

--------------------------------------------------------------------------------
-- | Instances of this class can execute Opaleye queries.
class (Monad m) => CanOpaleye m where
-- | Execute a query outside of a transaction. To run a query
-- inside a transaction use the 'transaction' function instead.
--
-- 'PostgreSQL.SqlError' exceptions are caught and returned via 'MonadError'.
liftQuery :: (MonadError e m, AsOpaleyeError e) => Query a -> m a
liftQuery :: Query a -> m a

instance CanOpaleye Query where
liftQuery = id

-- Default implementation:
instance (MonadIO m, MonadReader r m, HasOpaleye r) => CanOpaleye m where
instance (Monad m, MonadIO m, MonadOpaleye e r m) => CanOpaleye m where
liftQuery q = do
env <- view opaleye
(result :: Either PostgreSQL.SqlError a) <-
@@ -325,10 +334,7 @@ delete d = wrap (`O.runDelete_` d)
--
-- For complete details, please read the documentation for 'transaction''.
transaction
:: ( MonadError e m
, CanOpaleye m
, AsOpaleyeError e
)
:: ( CanOpaleye m )
=> Query a
-> m a
transaction = transaction' PostgreSQL.defaultTransactionMode
@@ -350,11 +356,7 @@ transaction = transaction' PostgreSQL.defaultTransactionMode
-- * If all retries are exhausted 'throwError' will be used to
-- return an error via the 'MonadError' constraint.
transaction'
:: forall e m a.
( MonadError e m
, CanOpaleye m
, AsOpaleyeError e
)
:: forall m a. ( CanOpaleye m )
=> TransactionMode
-> Query a
-> m a

Notiek ielāde…
Atcelt
Saglabāt