Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

table id field now customizable with id=... table attribute, may also…

… appear in entity columns
  • Loading branch information...
commit ad904b4e1ecd79b3a7d673fc267c051bced7476d 1 parent caab4a1
@simonmichael simonmichael authored
View
7 persistent-sqlite/Database/Persist/Sqlite.hs
@@ -144,14 +144,15 @@ getCopyTable :: PersistEntity val => (Text -> IO Statement) -> val
getCopyTable getter val = do
stmt <- getter $ pack $ "PRAGMA table_info(" ++ escape table ++ ")"
oldCols' <- withStmt stmt [] getCols
- let oldCols = map (RawName . unpack) $ filter (/= "id") oldCols'
+ let oldCols = map (RawName . unpack) $ filter (/= "id") oldCols' -- need to update for table id attribute ?
let newCols = map cName cols
let common = filter (`elem` oldCols) newCols
+ let id_ = rawTableIdName $ entityDef val
return [ (False, tmpSql)
- , (False, copyToTemp $ RawName "id" : common)
+ , (False, copyToTemp $ id_ : common)
, (common /= oldCols, pack dropOld)
, (False, newSql)
- , (False, copyToFinal $ RawName "id" : newCols)
+ , (False, copyToFinal $ id_ : newCols)
, (False, pack dropTmp)
]
where
View
6 persistent-template/Database/Persist/TH.hs
@@ -18,6 +18,7 @@ module Database.Persist.TH
import Database.Persist.Base
import Database.Persist.GenericSql (Migration, SqlPersist, migrate)
+import Database.Persist.GenericSql.Internal (unRawName,rawFieldName,rawTableIdName) -- XXX
import Database.Persist.Quasi (parse)
import Database.Persist.Util (deprecate, nullable)
import Database.Persist.TH.Library (apE)
@@ -235,7 +236,10 @@ mkEntity mps t = do
fpv <- mkFromPersistValues t
utv <- mkUniqueToValues $ entityUniques t
puk <- mkUniqueKeys t
- fields <- mapM (mkField t) $ ColumnDef "id" (entityName t ++ "Id") [] : entityColumns t
+ let colnames = map (unRawName . rawFieldName) $ entityColumns t
+ idname = unRawName $ rawTableIdName t
+ idname_ = (if idname `elem` colnames then (++"_") else id) idname
+ fields <- mapM (mkField t) $ ColumnDef idname_ (entityName t ++ "Id") [] : entityColumns t
return $
[ dataTypeDec t
, TySynD (mkName $ entityName t) [] $
View
4 persistent/Database/Persist/GenericSql.hs
@@ -192,7 +192,7 @@ instance MonadControlIO m => PersistBackend SqlPersist m where
off = if offset == 0
then ""
else " OFFSET " ++ show offset
- cols conn = intercalate "," $ "id"
+ cols conn = intercalate "," $ (unRawName $ rawTableIdName t)
: (map (\(x, _, _) -> escapeName conn x) $ tableColumns t)
sql conn = pack $ concat
[ "SELECT "
@@ -322,7 +322,7 @@ instance MonadControlIO m => PersistBackend SqlPersist m where
getBy uniq = do
conn <- SqlPersist ask
- let cols = intercalate "," $ "id"
+ let cols = intercalate "," $ (unRawName $ rawTableIdName t)
: (map (\(x, _, _) -> escapeName conn x) $ tableColumns t)
let sql = pack $ concat
[ "SELECT "
View
15 persistent/Database/Persist/GenericSql/Internal.hs
@@ -14,6 +14,7 @@ module Database.Persist.GenericSql.Internal
, tableColumns
, rawFieldName
, rawTableName
+ , rawTableIdName
, RawName (..)
, filterClause
, filterClauseNoWhere
@@ -117,6 +118,11 @@ getSqlValue (('s':'q':'l':'=':x):_) = Just x
getSqlValue (_:x) = getSqlValue x
getSqlValue [] = Nothing
+getIdNameValue :: [String] -> Maybe String
+getIdNameValue (('i':'d':'=':x):_) = Just x
+getIdNameValue (_:x) = getIdNameValue x
+getIdNameValue [] = Nothing
+
tableColumns :: EntityDef -> [(RawName, String, [String])]
tableColumns = map (\a@(ColumnDef _ y z) -> (rawFieldName a, y, z)) . entityColumns
@@ -134,6 +140,12 @@ rawTableName t = RawName $
Nothing -> entityName t
Just x -> x
+rawTableIdName :: EntityDef -> RawName
+rawTableIdName t = RawName $
+ case getIdNameValue $ entityAttribs t of
+ Nothing -> "id"
+ Just x -> x
+
newtype RawName = RawName { unRawName :: String } -- FIXME Text
deriving (Eq, Ord)
@@ -246,7 +258,8 @@ getFieldName :: EntityDef -> String -> RawName
getFieldName t s = rawFieldName $ tableColumn t s
tableColumn :: EntityDef -> String -> ColumnDef
-tableColumn _ "id" = ColumnDef "id" "Int64" []
+tableColumn t s | s == id_ = ColumnDef id_ "Int64" []
+ where id_ = unRawName $ rawTableIdName t
tableColumn t s = go $ entityColumns t
where
go [] = error $ "Unknown table column: " ++ s
View
3  persistent/Database/Persist/Join/Sql.hs
@@ -94,8 +94,9 @@ addTable conn e s = concat [escapeName conn $ rawTableName $ entityDef e, ".", s
colsPlusId :: PersistEntity e => Connection -> e -> [String]
colsPlusId conn e =
map (addTable conn e) $
- "id" : (map (\(x, _, _) -> escapeName conn x) cols)
+ id_ : (map (\(x, _, _) -> escapeName conn x) cols)
where
+ id_ = unRawName $ rawTableIdName $ entityDef e
cols = tableColumns $ entityDef e
filterName :: PersistEntity v => Filter v -> String
Please sign in to comment.
Something went wrong with that request. Please try again.