add deriveEverything + docs + codestyle

Author: s9gf4ult

src/Database/PostgreSQL/Query/TH.hs

@@ -3,6 +3,7 @@ module Database.PostgreSQL.Query.TH
          deriveFromRow
        , deriveToRow
        , deriveEntity
+       , deriveEverything
        , EntityOptions(..)
          -- * Embedding sql files
        , embedSql
@@ -37,31 +38,34 @@ cArgs (NormalC _ n) = return $ length n
 cArgs (RecC _ n) = return $ length n
 cArgs _ = error "Constructor must be simple"
 
+-- | Get field names from record constructor
 cFieldNames :: Con -> [Name]
 cFieldNames (RecC _ vst) = map (\(a, _, _) -> a) vst
 cFieldNames _ = error "Constructor must be a record (product type with field names)"
 
--- | Derive 'FromRow' instance. i.e. you have type like that
---
--- @
--- data Entity = Entity
---               { eField :: Text
---               , eField2 :: Int
---               , efield3 :: Bool }
--- @
---
--- then 'deriveFromRow' will generate this instance:
--- instance FromRow Entity where
---
--- @
--- instance FromRow Entity where
---     fromRow = Entity
---               \<$> field
---               \<*> field
---               \<*> field
--- @
---
--- Datatype must have just one constructor with arbitrary count of fields
+{-| Derive 'FromRow' instance. i.e. you have type like that
+
+@
+data Entity = Entity
+              { eField :: Text
+              , eField2 :: Int
+              , efield3 :: Bool }
+@
+
+then 'deriveFromRow' will generate this instance:
+instance FromRow Entity where
+
+@
+instance FromRow Entity where
+    fromRow = Entity
+              \<$> field
+              \<*> field
+              \<*> field
+@
+
+Datatype must have just one constructor with arbitrary count of fields
+-}
+
 deriveFromRow :: Name -> Q [Dec]
 deriveFromRow t = do
     TyConI (DataD _ _ _ [con] _) <- reify t
@@ -87,24 +91,26 @@ lookupVNameErr name =
           return
 
 
--- | derives 'ToRow' instance for datatype like
---
--- @
--- data Entity = Entity
---               { eField :: Text
---               , eField2 :: Int
---               , efield3 :: Bool }
--- @
---
--- it will derive instance like that:
---
--- @
--- instance ToRow Entity where
---      toRow (Entity e1 e2 e3) =
---          [ toField e1
---          , toField e2
---          , toField e3 ]
--- @
+{-| derives 'ToRow' instance for datatype like
+
+@
+data Entity = Entity
+              { eField :: Text
+              , eField2 :: Int
+              , efield3 :: Bool }
+@
+
+it will derive instance like that:
+
+@
+instance ToRow Entity where
+     toRow (Entity e1 e2 e3) =
+         [ toField e1
+         , toField e2
+         , toField e3 ]
+@
+-}
+
 deriveToRow :: Name -> Q [Dec]
 deriveToRow t = do
     TyConI (DataD _ _ _ [con] _) <- reify t
@@ -123,6 +129,7 @@ deriveToRow t = do
             (\e -> AppE (VarE tof) (VarE e))
             v
 
+-- | Options for deriving `Entity`
 data EntityOptions = EntityOptions
     { eoTableName      :: String -> String -- ^ Type name to table name converter
     , eoColumnNames    :: String -> String -- ^ Record field to column name converter
@@ -138,7 +145,44 @@ instance Default EntityOptions where
         , eoIdType = ''Integer
         }
 
--- | Derives instance for 'Entity' using type name and field names.
+{- | Derives instance for 'Entity' using type name and field names. Also
+generates type synonim for ID. E.g. code like this:
+
+@
+data Agent = Agent
+    { aName          :: !Text
+    , aAttributes    :: !HStoreMap
+    , aLongWeirdName :: !Int
+    } deriving (Ord, Eq, Show)
+
+$(deriveEntity
+  def { eoIdType      = ''Id
+      , eoTableName   = toUnderscore
+      , eoColumnNames = toUnderscore . drop 1
+      , eoDeriveClassess =
+        [''Show, ''Read, ''Ord, ''Eq
+        , ''FromField, ''ToField, ''PathPiece]
+      }
+  ''Agent )
+@
+
+Will generate code like this:
+
+@
+instance Database.PostgreSQL.Query.Entity Agent where
+    newtype EntityId Agent
+        = AgentId {getAgentId :: Id}
+        deriving (Show, Read, Ord, Eq, FromField, ToField, PathPiece)
+    tableName _ = "agent"
+    fieldNames _ = ["name", "attributes", "long_weird_name"]
+type AgentId = EntityId Agent
+@
+
+So, you dont need to write it by hands any more.
+
+NOTE: 'toUnderscore' is from package 'inflections' here
+-}
+
 deriveEntity :: EntityOptions -> Name -> Q [Dec]
 deriveEntity opts tname = do
     TyConI (DataD _ _ _ [tcon] _) <- reify tname
@@ -154,16 +198,62 @@ deriveEntity opts tname = do
                 idcon (eoDeriveClassess opts)
         tblName = eoTableName opts tnames
         fldNames = map (eoColumnNames opts . nameBase) $ cFieldNames tcon
-    VarE tableName  <- [e|tableName|]
-    VarE fieldNames <- [e|fieldNames|]
-    let tbldec = FunD tableName  [Clause [WildP] (NormalB $ LitE  $ stringL tblName) []]
-        flddec = FunD fieldNames [Clause [WildP] (NormalB $ ListE $ map (LitE . stringL) fldNames) []]
+    VarE ntableName  <- [e|tableName|]
+    VarE nfieldNames <- [e|fieldNames|]
+    let tbldec = FunD ntableName  [Clause [WildP] (NormalB $ LitE  $ stringL tblName) []]
+        flddec = FunD nfieldNames [Clause [WildP] (NormalB $ ListE $ map (LitE . stringL) fldNames) []]
         ret = InstanceD [] econt
               [ iddec, tbldec, flddec ]
         syndec = TySynD (mkName idname) [] (AppT (ConT entityIdName) (ConT tname))
     return [ret, syndec]
 
+{- | Calls sequently `deriveFromRow` `deriveToRow` `deriveEntity`. E.g. code like this:
+
+@
+data Agent = Agent
+    { aName          :: !Text
+    , aAttributes    :: !HStoreMap
+    , aLongWeirdName :: !Int
+    } deriving (Ord, Eq, Show)
+
+$(deriveEverything
+  def { eoIdType      = ''Id
+      , eoTableName   = toUnderscore
+      , eoColumnNames = toUnderscore . drop 1
+      , eoDeriveClassess =
+        [''Show, ''Read, ''Ord, ''Eq
+        , ''FromField, ''ToField, ''PathPiece]
+      }
+  ''Agent )
+@
+
+will generate that:
+
+@
+instance ToRow Agent where
+    toRow (Agent a_aE3w a_aE3x a_aE3y)
+        = [toField a_aE3w, toField a_aE3x, toField a_aE3y]
+instance FromRow Agent where
+  fromRow
+      = Agent <$> Database.PostgreSQL.Simple.FromRow.field
+        <*> Database.PostgreSQL.Simple.FromRow.field
+        <*> Database.PostgreSQL.Simple.FromRow.field
+instance Database.PostgreSQL.Query.Entity Agent where
+    newtype EntityId Agent
+        = AgentId {getAgentId :: Id}
+        deriving (Show, Read, Ord, Eq, FromField, ToField, PathPiece)
+    tableName _ = "agent"
+    fieldNames _ = ["name", "attributes", "long_weird_name"]
+type AgentId = EntityId Agent
+@
+
+-}
 
+deriveEverything :: EntityOptions -> Name -> Q [Dec]
+deriveEverything opts tname = fmap concat $ sequence
+    [ deriveToRow tname
+    , deriveFromRow tname
+    , deriveEntity opts tname ]
 
 -- embed sql file as value
 embedSql :: String               -- ^ File path