groundhog-th 0.10.1 → 0.10.2
raw patch · 4 files changed
+23/−24 lines, 4 filesdep +libyamldep ~yamlPVP ok
version bump matches the API change (PVP)
Dependencies added: libyaml
Dependency ranges changed: yaml
API changes (from Hackage documentation)
Files
- Database/Groundhog/TH.hs +0/−5
- Database/Groundhog/TH/CodeGen.hs +17/−17
- changelog +3/−0
- groundhog-th.cabal +3/−2
Database/Groundhog/TH.hs view
@@ -598,13 +598,8 @@ , replicate (Y.yamlColumn mark) ' ' ++ "^" ] _ -> fail $ show err-#if MIN_VERSION_yaml(0, 10, 0) Right (_, Left err) -> fail err Right (_, Right result') -> lift (result' :: PersistDefinitions)-#else- Right (Left err) -> fail err- Right (Right result') -> lift (result' :: PersistDefinitions)-#endif defaultMkEntityDecs :: [THEntityDef] -> Q [Dec] defaultMkEntityDecs = fmap concat . mapM (\def -> do
Database/Groundhog/TH/CodeGen.hs view
@@ -23,7 +23,7 @@ , mkPrimitivePrimitivePersistFieldInstance , mkMigrateFunction ) where - + import Database.Groundhog.Core import Database.Groundhog.Generic import Database.Groundhog.TH.Settings @@ -196,7 +196,7 @@ Just _ -> do let entity = foldl AppT (ConT (thDataName def)) $ map extractType $ thTypeParams def keyType <- [t| Key $(return entity) BackendSpecific |] - + persistName' <- do a <- newName "a" let body = [| "Key" ++ [delim] ++ persistName ((undefined :: Key v u -> v) $(varE a)) |] @@ -209,7 +209,7 @@ let e = [| entityDef $(varE proxy) ((undefined :: Key v a -> v) $(varE a)) |] body = [| DbTypePrimitive (getDefaultAutoKeyType $(varE proxy)) False Nothing (Just (Left ($e, Nothing), Nothing, Nothing)) |] funD 'dbType [clause [varP proxy, varP a] (normalB body) []] - + let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields) let decs = [persistName', toPersistValues', fromPersistValues', dbType'] return [instanceD' context (AppT (ConT ''PersistField) keyType) decs] @@ -274,7 +274,7 @@ uniqKeyType <- [t| Key $(return entity) (Unique $(conT $ mkName $ thUniqueKeyPhantomName unique)) |] let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields) mkEmbeddedInstance' uniqKeyType (thUniqueKeyFields unique) context - + mkUniqueKeysPersistFieldInstances :: THEntityDef -> Q [Dec] mkUniqueKeysPersistFieldInstances def = do let entity = foldl AppT (ConT (thDataName def)) $ map extractType $ thTypeParams def @@ -302,7 +302,7 @@ let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields) let decs = [persistName', toPersistValues', fromPersistValues', dbType'] return $ instanceD' context (AppT (ConT ''PersistField) uniqKeyType) decs - + mkUniqueKeysPrimitiveOrPurePersistFieldInstances :: THEntityDef -> Q [Dec] mkUniqueKeysPrimitiveOrPurePersistFieldInstances def = do let entity = foldl AppT (ConT (thDataName def)) $ map extractType $ thTypeParams def @@ -321,7 +321,7 @@ fromPrim' <- funD 'fromPrimitivePersistValue [clause [varP x] (normalB [| $(conE conName) (fromPrimitivePersistValue $(varE x)) |]) []] let decs = [toPrim', fromPrim'] sequence [ return $ instanceD' context (AppT (ConT ''PrimitivePersistField) uniqKeyType) decs - , return $ instanceD' context (AppT (ConT ''NeverNull) uniqKeyType) decs + , return $ instanceD' context (AppT (ConT ''NeverNull) uniqKeyType) [] , mkDefaultPurePersistFieldInstance context uniqKeyType , mkDefaultSinglePersistFieldInstance context uniqKeyType] else mkPurePersistFieldInstance uniqKeyType conName (thUniqueKeyFields unique) context @@ -344,7 +344,7 @@ body = [| showParen ($(varE p) >= (11 :: Int)) ($showC . $showArgs) |] clause [varP p, pat] (normalB body) [] in funD 'showsPrec $ map mkClause keysInfo - + eq' <- let mkClause (cName, fieldsNum, _) = do let fields = replicateM fieldsNum (newName "x") @@ -377,7 +377,7 @@ embedded = foldl AppT (ConT (thEmbeddedName def)) types context = paramsContext (thEmbeddedTypeParams def) (thEmbeddedFields def) mkEmbeddedInstance' embedded (thEmbeddedFields def) context - + mkEmbeddedInstance' :: Type -> [THFieldDef] -> Cxt -> Q [Dec] mkEmbeddedInstance' dataType fDefs context = do selector' <- do @@ -402,7 +402,7 @@ phantom <- [t| ConstructorMarker $(return entity) |] let constr = ForallC (thTypeParams def) [equalP' (VarT v) phantom] $ NormalC name [] return $ dataD' [] name [PlainTV v] [constr] [] - + mkEntityPhantomConstructorInstances :: THEntityDef -> Q [Dec] mkEntityPhantomConstructorInstances def = sequence $ zipWith f [0..] $ thConstructors def where f :: Int -> THConstructorDef -> Q Dec @@ -422,7 +422,7 @@ let constr = ForallC (thTypeParams def) [equalP' (VarT v) phantom] $ NormalC name [] return [dataD' [] name [PlainTV v] [constr] []] else return [] - + mkPersistEntityInstance :: THEntityDef -> Q [Dec] mkPersistEntityInstance def = do let entity = foldl AppT (ConT (thDataName def)) $ map extractType $ thTypeParams def @@ -448,7 +448,7 @@ Nothing -> [t| () |] Just _ -> [t| Key $(return entity) BackendSpecific |] return $ mkTySynInstD ''AutoKey [entity] autoType - + defaultKey' <- do typ <- case thAutoKey def of Just k | thAutoKeyIsDef k -> [t| Key $(return entity) BackendSpecific |] @@ -462,7 +462,7 @@ then ''HFalse else ''HTrue return $ mkTySynInstD ''IsSumType [entity] isSumType - + fields' <- do cParam <- newName "c" fParam <- newName "f" @@ -470,7 +470,7 @@ let f cdef = map (mkField $ mkName $ thPhantomConstrName cdef) $ thConstrFields cdef let constrs = concatMap f $ thConstructors def return $ dataInstD' [] ''Field [entity, VarT cParam, VarT fParam] constrs [] - + entityDef' <- do v <- newName "v" proxy <- newName "p" @@ -493,7 +493,7 @@ mkConstraint (THUniqueDef uName uType uFields) = [| UniqueDef (Just uName) uType $(listE $ map getField uFields) |] getField (Left fName) = [| Left $(snd $ findOne "field" fst fName fields) |] getField (Right expr) = [| Right expr |] - + paramNames = foldr1 (\p xs -> [| $p ++ [delim] ++ $xs |] ) $ map (\t -> [| persistName ($(mkLambda t) $(varE v)) |]) types fullEntityName = case null types of True -> [| $(stringE $ thDbEntityName def) |] @@ -575,11 +575,11 @@ Just defaultKey -> do let types = map extractType $ thTypeParams def let entity = foldl AppT (ConT (thDataName def)) types - + persistName' <- do v <- newName "v" let mkLambda t = [|undefined :: $(forallT (thTypeParams def) (cxt []) [t| $(return entity) -> $(return t) |]) |] - + let paramNames = foldr1 (\p xs -> [| $p ++ [delim] ++ $xs |] ) $ map (\t -> [| persistName ($(mkLambda t) $(varE v)) |]) types let fullEntityName = case null types of True -> [| $(stringE $ thDbEntityName def) |] @@ -587,7 +587,7 @@ let body = normalB $ fullEntityName let pat = if null types then wildP else varP v funD 'persistName $ [ clause [pat] body [] ] - + isOne <- isDefaultKeyOneColumn def let uniqInfo = either auto uniq defaultKey where auto _ = Nothing
changelog view
@@ -1,3 +1,6 @@+0.10.2+* Bump yaml to 0.11+ 0.10.1 * Add upper bound to yaml
groundhog-th.cabal view
@@ -1,5 +1,5 @@ name: groundhog-th-version: 0.10.1+version: 0.10.2 license: BSD3 license-file: LICENSE author: Boris Lykah <lykahb@gmail.com>@@ -23,7 +23,8 @@ , containers >= 0.2 , unordered-containers >= 0.1.3 , aeson >= 0.7- , yaml >= 0.8.1 && < 0.11+ , yaml >= 0.11 && < 0.12+ , libyaml , text >= 0.8 exposed-modules: Database.Groundhog.TH Database.Groundhog.TH.Settings