persistent-template 2.1.1 → 2.1.3

raw patch · 2 files changed

+50/−17 lines, 2 filesdep ~persistentPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: persistent

API changes (from Hackage documentation)

Files

• Database/Persist/TH.hs +48/−15
• persistent-template.cabal +2/−2

@@ -105,18 +105,45 @@ -- afterwards, sets references to other entities parseReferences :: PersistSettings -> Text -> Q Exp parseReferences ps s = lift $-     map (mkEntityDefSqlTypeExp entityMap) entsWithEmbeds+     map (mkEntityDefSqlTypeExp entityMap . breakCycleEnt) entsWithEmbeds   where     -- every EntityDef could reference each-other (as an EmbedRef)     -- let Haskell tie the knot     entityMap = M.fromList $ map (\ent -> (entityHaskell ent, toEmbedEntityDef ent)) entsWithEmbeds     entsWithEmbeds = map setEmbedEntity rawEnts     setEmbedEntity ent = ent-      { entityFields = map (setEmbedField entityMap) $ entityFields ent+      { entityFields = map (setEmbedField (entityHaskell ent) entityMap) $ entityFields ent       }     rawEnts = parse ps s +    -- self references are already broken+    -- look at every emFieldEmbed to see if it refers to an already seen HaskellName+    -- so start with entityHaskell ent and accumulate embeddedHaskell em+    breakCycleEnt entDef =+      let entName = entityHaskell entDef+      in  entDef { entityFields = map (breakCycleField entName) $ entityFields entDef } +    breakCycleField entName f@(FieldDef { fieldReference = EmbedRef em }) =+      f { fieldReference = EmbedRef $ breakCycleEmbed [entName] em }+    breakCycleField _ f = f++    breakCycleEmbed ancestors em =+        em { embeddedFields = map (breakCycleEmField $ emName : ancestors)+                                  (embeddedFields em)+           }+      where+        emName = embeddedHaskell em++    breakCycleEmField ancestors emf = case embeddedHaskell <$> membed of+        Nothing -> emf+        Just embName -> if embName `elem` ancestors+          then emf { emFieldEmbed = Nothing, emFieldCycle = Just embName }+          else emf { emFieldEmbed = breakCycleEmbed ancestors <$> membed }+      where+        membed = emFieldEmbed emf+++ stripId :: FieldType -> Maybe Text stripId (FTTypeCon Nothing t) = stripSuffix "Id" t stripId _ = Nothing@@ -168,12 +195,13 @@     lift (ForeignRef name ft) = [|ForeignRef name ft|]     lift (EmbedRef em) = [|EmbedRef em|]     lift (CompositeRef cdef) = [|CompositeRef cdef|]+    lift (SelfReference) = [|SelfReference|]  instance Lift EmbedEntityDef where     lift (EmbedEntityDef name fields) = [|EmbedEntityDef name fields|]  instance Lift EmbedFieldDef where-    lift (EmbedFieldDef name em) = [|EmbedFieldDef name em|]+    lift (EmbedFieldDef name em cyc) = [|EmbedFieldDef name em cyc|]  type EntityMap = M.Map HaskellName EmbedEntityDef mEmbedded :: EntityMap -> FieldType -> Maybe EmbedEntityDef@@ -183,19 +211,24 @@ mEmbedded ents (FTList x) = mEmbedded ents x mEmbedded ents (FTApp x y) = maybe (mEmbedded ents y) Just (mEmbedded ents x) -setEmbedField :: EntityMap -> FieldDef -> FieldDef-setEmbedField allEntities field = field+setEmbedField :: HaskellName -> EntityMap -> FieldDef -> FieldDef+setEmbedField entName allEntities field = field   { fieldReference = case fieldReference field of-      NoReference -> case mEmbedded allEntities (fieldType field) of-          Nothing -> case stripId $ fieldType field of-              Nothing -> NoReference-              Just name -> if M.member (HaskellName name) allEntities-                  then ForeignRef (HaskellName name)-                                  -- the EmebedEntityDef does not contain FieldType information-                                  -- but we shouldn't need this anyway-                                  (FTTypeCon Nothing $ pack $ nameBase ''Int)-                  else NoReference-          Just em -> EmbedRef em+      NoReference ->+        case mEmbedded allEntities (fieldType field) of+            Nothing -> case stripId $ fieldType field of+                Nothing -> NoReference+                Just name -> if M.member (HaskellName name) allEntities+                    then ForeignRef (HaskellName name)+                                    -- the EmebedEntityDef does not contain FieldType information+                                    -- but we shouldn't need this anyway+                                    (FTTypeCon Nothing $ pack $ nameBase ''Int)+                    else NoReference+            Just em -> if embeddedHaskell em /= entName+              then EmbedRef em+              else if maybeNullable field+                     then SelfReference+                     else error $ unpack $ unHaskellName entName `mappend` ": a self reference must be a Maybe"       existing@_   -> existing   } 

@@ -1,5 +1,5 @@ name:            persistent-template-version:         2.1.1+version:         2.1.3 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -17,7 +17,7 @@ library     build-depends:   base                     >= 4.6         && < 5                    , template-haskell-                   , persistent               >= 2.1       && < 3+                   , persistent               >= 2.1.3     && < 3                    , monad-control            >= 0.2       && < 1.1                    , bytestring               >= 0.9                    , text                     >= 0.5