diff --git a/Database/SQLite/Simple/FromRow.hs b/Database/SQLite/Simple/FromRow.hs --- a/Database/SQLite/Simple/FromRow.hs +++ b/Database/SQLite/Simple/FromRow.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, DefaultSignatures, FlexibleContexts, + StandaloneDeriving #-} ------------------------------------------------------------------------------ -- | @@ -17,7 +18,8 @@ ------------------------------------------------------------------------------ module Database.SQLite.Simple.FromRow - ( FromRow(..) + ( GFromRow(..) + , FromRow(..) , RowParser , field , fieldWith @@ -29,19 +31,53 @@ import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader import Control.Monad.Trans.Class +import GHC.Generics import Database.SQLite.Simple.FromField import Database.SQLite.Simple.Internal import Database.SQLite.Simple.Ok import Database.SQLite.Simple.Types + +-- | Generic derivation of 'FromRow'. +-- +-- Instantiating 'FromRow' can in some cases be quite tedious. Luckily +-- we can derive it generically in some cases where the type at hand +-- has a 'Generic' instance. The current implementation only works +-- for a (n-ary) product types. So we would not be able to +-- e.g. derive a 'FromRow' instance for +-- +-- @ +-- data Bool = True | False +-- @ +-- +-- We /can/, however, derive a generic instance for the @User@ type +-- (see the example in 'FromRow'). +-- +-- @since 0.4.18.1 +class GFromRow f where + gfromRow :: RowParser (f a) + +instance GFromRow U1 where + gfromRow = pure U1 + +instance FromField a => GFromRow (K1 i a) where + gfromRow = K1 <$> field + +instance GFromRow a => GFromRow (M1 i c a) where + gfromRow = M1 <$> gfromRow + +instance (GFromRow a, GFromRow b) => GFromRow (a :*: b) where + gfromRow = (:*:) <$> gfromRow <*> gfromRow + -- | A collection type that can be converted from a sequence of fields. -- Instances are provided for tuples up to 10 elements and lists of any length. -- -- Note that instances can defined outside of sqlite-simple, which is -- often useful. For example, here's an instance for a user-defined pair: -- --- @data User = User { name :: String, fileQuota :: Int } +-- @ +-- data User = User { name :: String, fileQuota :: Int } -- -- instance 'FromRow' User where -- fromRow = User \<$\> 'field' \<*\> 'field' @@ -53,9 +89,29 @@ -- -- Note the caveats associated with user-defined implementations of -- 'fromRow'. - +-- +-- === Generic implementation +-- +-- Since version 0.4.18.1 it is possible in some cases to derive a +-- generic implementation for 'FromRow'. With a 'Generic' instance +-- for @User@, the example above could be written: +-- +-- @ +-- instance 'FromRow' User where +-- @ +-- +-- With @-XDeriveAnyClass -XDerivingStrategies@ the same can be written: +-- +-- @ +-- deriving anyclass instance 'FromRow' User +-- @ +-- +-- For more details refer to 'GFromRow'. class FromRow a where fromRow :: RowParser a + + default fromRow :: Generic a => GFromRow (Rep a) => RowParser a + fromRow = to <$> gfromRow fieldWith :: FieldParser a -> RowParser a fieldWith fieldP = RP $ do diff --git a/Database/SQLite/Simple/ToRow.hs b/Database/SQLite/Simple/ToRow.hs --- a/Database/SQLite/Simple/ToRow.hs +++ b/Database/SQLite/Simple/ToRow.hs @@ -1,3 +1,5 @@ +{-# Language DefaultSignatures, FlexibleContexts, DeriveAnyClass, + StandaloneDeriving #-} ------------------------------------------------------------------------------ -- | -- Module: Database.SQLite.Simple.ToRow @@ -17,52 +19,58 @@ ------------------------------------------------------------------------------ module Database.SQLite.Simple.ToRow - ( - ToRow(..) + ( GToRow(..) + , ToRow(..) ) where +import GHC.Generics + import Database.SQLite.Simple.ToField (ToField(..)) import Database.SQLite.Simple.Types (Only(..), (:.)(..)) import Database.SQLite3 (SQLData(..)) --- | A collection type that can be turned into a list of 'SQLData' --- elements. -class ToRow a where - toRow :: a -> [SQLData] - -- ^ 'ToField' a collection of values. - -instance ToRow () where - toRow _ = [] +-- | Generic derivation of 'ToRow'. For details about what can be +-- derived refer to 'Database.Sqlite.Simple.FromRow.GFromRow'. +-- +-- @since 0.4.18.1 +class GToRow f where + gtoRow :: (f a) -> [SQLData] -instance (ToField a) => ToRow (Only a) where - toRow (Only v) = [toField v] +instance GToRow U1 where + gtoRow U1 = mempty -instance (ToField a, ToField b) => ToRow (a,b) where - toRow (a,b) = [toField a, toField b] +instance ToField a => GToRow (K1 i a) where + gtoRow (K1 a) = pure $ toField a -instance (ToField a, ToField b, ToField c) => ToRow (a,b,c) where - toRow (a,b,c) = [toField a, toField b, toField c] +instance (GToRow a, GToRow b) => GToRow (a :*: b) where + gtoRow (a :*: b) = gtoRow a `mappend` gtoRow b -instance (ToField a, ToField b, ToField c, ToField d) => ToRow (a,b,c,d) where - toRow (a,b,c,d) = [toField a, toField b, toField c, toField d] +instance GToRow a => GToRow (M1 i c a) where + gtoRow (M1 a) = gtoRow a -instance (ToField a, ToField b, ToField c, ToField d, ToField e) - => ToRow (a,b,c,d,e) where - toRow (a,b,c,d,e) = - [toField a, toField b, toField c, toField d, toField e] +-- | A collection type that can be turned into a list of 'SQLData' +-- elements. +-- +-- Since version 0.4.18.1 it is possible in some cases to derive a +-- generic implementation for 'ToRow'. Refer to the documentation for +-- 'Database.Sqlite.Simple.FromRow.FromRow' to see how this can be +-- done. +class ToRow a where + toRow :: a -> [SQLData] + -- ^ 'ToField' a collection of values. -instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) - => ToRow (a,b,c,d,e,f) where - toRow (a,b,c,d,e,f) = - [toField a, toField b, toField c, toField d, toField e, toField f] + default toRow :: Generic a => GToRow (Rep a) => a -> [SQLData] + toRow a = gtoRow $ from a -instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, - ToField g) - => ToRow (a,b,c,d,e,f,g) where - toRow (a,b,c,d,e,f,g) = - [toField a, toField b, toField c, toField d, toField e, toField f, - toField g] +deriving instance ToRow () +deriving instance (ToField a) => ToRow (Only a) +deriving instance (ToField a, ToField b) => ToRow (a,b) +deriving instance (ToField a, ToField b, ToField c) => ToRow (a,b,c) +deriving instance (ToField a, ToField b, ToField c, ToField d) => ToRow (a,b,c,d) +deriving instance (ToField a, ToField b, ToField c, ToField d, ToField e) => ToRow (a,b,c,d,e) +deriving instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) => ToRow (a,b,c,d,e,f) +deriving instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g) => ToRow (a,b,c,d,e,f,g) instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h) diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,7 +1,13 @@ +0.4.18.2 + * Depend on semigroups only for old GHC versions + +0.4.18.1 + * Add generic implementation of 'FromRow' and 'ToRow'. + 0.4.16.0 * Add FromField instance for SQLData (thanks @LindaOrtega, @Shimuuar) * Add QuasiQuoter sql (thanks @vrom911) - + 0.4.15.0 * Support GHC 8.4.1 (Add instance Semigroup Query) (thanks @gwils!) diff --git a/sqlite-simple.cabal b/sqlite-simple.cabal --- a/sqlite-simple.cabal +++ b/sqlite-simple.cabal @@ -1,10 +1,10 @@ Name: sqlite-simple -Version: 0.4.18.0 +Version: 0.4.18.2 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple. . - Main documentation (with examples): + Main documentation (with examples): . You can view the project page at for more information. @@ -51,12 +51,14 @@ bytestring >= 0.9, containers, direct-sqlite >= 2.3.13 && < 2.4, - semigroups >= 0.18 && < 0.20, template-haskell, text >= 0.11, time, transformers, Only >= 0.1 && < 0.1.1 + + if impl(ghc < 8.0) + Build-depends: semigroups >= 0.18 && < 0.20 default-extensions: DoAndIfThenElse