persistent-template 0.8.1 → 0.8.1.1

raw patch · 2 files changed

+19/−12 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Database/Persist/TH.hs +18/−11
• persistent-template.cabal +1/−1

@@ -327,13 +327,13 @@         : entityFields t     toFieldNames <- mkToFieldNames $ entityUniques t -    return +    return       [ dataTypeDec t       , TySynD (mkName nameS) [] $             ConT (mkName $ unpack $ nameT ++ suffix)                 `AppT` mpsBackend mps       , TySynD (mkName $ unpack $ unHaskellName (entityHaskell t) ++ "Id") [] $-            ConT ''Key `AppT` mpsBackend mps `AppT` ConT (mkName nameS) +            ConT ''Key `AppT` mpsBackend mps `AppT` ConT (mkName nameS)       , InstanceD [] clazz $         [ uniqueTypeDec t         , FunD (mkName "entityDef") [Clause [WildP] (NormalB t') []]@@ -368,7 +368,7 @@ --        casefromPersistValue v of --            Left e -> error e --            Right r -> r) o---    fromPersistValue x = Left $ "Expected PersistMap, received: " ++ show x +--    fromPersistValue x = Left $ "Expected PersistMap, received: " ++ show x --    sqlType _ = SqlString persistFieldFromEntity :: EntityDef -> Q [Dec] persistFieldFromEntity e = do@@ -552,7 +552,7 @@                             [] -> Left $ "Invalid " ++ dt ++ ": " ++ s'|]     return         [ persistFieldInstanceD (ConT $ mkName s)-            [ sqlTypeFunD ss +            [ sqlTypeFunD ss             , FunD (mkName "toPersistValue")                 [ Clause [] (NormalB tpv) []                 ]@@ -585,15 +585,22 @@     body =         case defs of             [] -> [|return ()|]-            _ -> DoE `fmap` mapM toStmt defs-    toStmt :: EntityDef -> Q Stmt-    toStmt ed = do-        let n = entityHaskell ed+            _  -> do+              defsName <- newName "defs"+              defsStmt <- do+                u <- [|undefined|]+                e <- [|entityDef|]+                let defsExp = ListE $ map (AppE e . undefinedEntityTH u) defs+                return $ LetS [ValD (VarP defsName) (NormalB defsExp) []]+              stmts <- mapM (toStmt $ VarE defsName) defs+              return (DoE $ defsStmt : stmts)+    toStmt :: Exp -> EntityDef -> Q Stmt+    toStmt defsExp ed = do         u <- [|undefined|]         m <- [|migrate|]-        defs' <- lift defs-        let u' = SigE u $ ConT $ mkName $ unpack $ unHaskellName n-        return $ NoBindS $ m `AppE` defs' `AppE` u'+        return $ NoBindS $ m `AppE` defsExp `AppE` (undefinedEntityTH u ed)+    undefinedEntityTH :: Exp -> EntityDef -> Exp+    undefinedEntityTH u = SigE u . ConT . mkName . unpack . unHaskellName . entityHaskell  instance Lift EntityDef where     lift (EntityDef a b c d e f g h) =

@@ -1,5 +1,5 @@ name:            persistent-template-version:         0.8.1+version:         0.8.1.1 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>