From 72aad8659d5eab76ea5d2c9bce0f1da7c235e6f2 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 20 Jun 2010 10:33:55 +0300
Subject: [PATCH] persistent changes

---
 Yesod/Formable.hs     | 20 +++++++++++---------
 Yesod/Helpers/Crud.hs |  3 ++-
 Yesod/Yesod.hs        |  4 ++--
 3 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/Yesod/Formable.hs b/Yesod/Formable.hs
index 1bd8d556..cc7d56d1 100644
--- a/Yesod/Formable.hs
+++ b/Yesod/Formable.hs
@@ -25,7 +25,8 @@ module Yesod.Formable
 import Text.Hamlet
 import Data.Time (Day)
 import Control.Applicative
-import Database.Persist (Persistable, Table (..))
+import Database.Persist (PersistField)
+import Database.Persist.Helper (EntityDef (..))
 import Data.Char (isAlphaNum, toUpper, isUpper)
 import Language.Haskell.TH.Syntax
 import Control.Monad (liftM, join)
@@ -159,7 +160,7 @@ instance Formable (Maybe String) where
             | null s = Right Nothing
             | otherwise = Right $ Just s
 
-instance Formable Html where
+instance Formable (Html ()) where
     formable = fmap preEscapedString
               . input' go
               . fmap (Data.ByteString.Lazy.UTF8.toString . renderHtml)
@@ -257,7 +258,7 @@ instance Formable Int where
                     [] -> Left ["Invalid integer"]
 
 newtype Slug = Slug { unSlug :: String }
-    deriving (Read, Eq, Show, SinglePiece, Persistable)
+    deriving (Read, Eq, Show, SinglePiece, PersistField)
 
 instance Formable Slug where
     formable x = input' go (fmap unSlug x) `check` asSlug
@@ -277,28 +278,29 @@ share2 f g a = do
     g' <- g a
     return $ f' ++ g'
 
-deriveFormable :: [Table] -> Q [Dec]
+deriveFormable :: [EntityDef] -> Q [Dec]
 deriveFormable = mapM derive
   where
-    derive :: Table -> Q Dec
+    derive :: EntityDef -> Q Dec
     derive t = do
-        let cols = map (toLabel . fst) $ tableColumns t
+        let fst3 (x, _, _) = x
+        let cols = map (toLabel . fst3) $ entityColumns t
         ap <- [|(<*>)|]
         just <- [|pure|]
         nothing <- [|Nothing|]
-        let just' = just `AppE` ConE (mkName $ tableName t)
+        let just' = just `AppE` ConE (mkName $ entityName t)
         let c1 = Clause [ ConP (mkName "Nothing") []
                         ]
                         (NormalB $ go ap just' $ zip cols $ map (const nothing) cols)
                         []
         xs <- mapM (const $ newName "x") cols
         let xs' = map (AppE just . VarE) xs
-        let c2 = Clause [ ConP (mkName "Just") [ConP (mkName $ tableName t)
+        let c2 = Clause [ ConP (mkName "Just") [ConP (mkName $ entityName t)
                             $ map VarP xs]]
                         (NormalB $ go ap just' $ zip cols xs')
                         []
         return $ InstanceD [] (ConT ''Formable
-                              `AppT` ConT (mkName $ tableName t))
+                              `AppT` ConT (mkName $ entityName t))
             [FunD (mkName "formable") [c1, c2]]
     go ap just' = foldl (ap' ap) just' . map go'
     go' (label, ex) =
diff --git a/Yesod/Helpers/Crud.hs b/Yesod/Helpers/Crud.hs
index 21224b1a..6c35cb3a 100644
--- a/Yesod/Helpers/Crud.hs
+++ b/Yesod/Helpers/Crud.hs
@@ -153,7 +153,8 @@ crudHelper title me isPost = do
                     %a!href=@toMaster.CrudDeleteR.toSinglePiece.fst.e@ Delete
 |]
 
-defaultCrud :: (Persist i (YesodDB a (GHandler (Crud a i) a)), YesodPersist a)
+defaultCrud :: (PersistEntity i, YesodPersist a,
+               PersistMonad i ~ YesodDB a (GHandler (Crud a i) a))
             => a -> Crud a i
 defaultCrud = const Crud
     { crudSelect = runDB $ select [] []
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 3cf87abe..c3b129e0 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -8,7 +8,7 @@ module Yesod.Yesod
     , YesodSite (..)
       -- ** Persistence
     , YesodPersist (..)
-    , Persist (..)
+    , PersistEntity (..)
       -- * Convenience functions
     , applyLayout
     , applyLayoutJson
@@ -27,7 +27,7 @@ import Web.ClientSession (getKey, defaultKeyFile)
 import qualified Web.ClientSession as CS
 import Data.Monoid (mempty)
 import Data.ByteString.UTF8 (toString)
-import Database.Persist (Persist (..))
+import Database.Persist (PersistEntity (..))
 
 import Web.Routes.Quasi (QuasiSite (..), Routes)