{To,From}Field for NominalDiffTime

Database/SQLite/Simple/FromField.hs

@@ -34,13 +34,12 @@ module Database.SQLite.Simple.FromField
     , returnError
     ) where
 
-import           Control.Applicative (Applicative, (<$>), pure)
 import           Control.Exception (SomeException(..), Exception)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
 import           Data.Int (Int8, Int16, Int32, Int64)
-import           Data.Time (UTCTime, Day)
+import           Data.Time (UTCTime, Day, NominalDiffTime)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as LT
 import           Data.Typeable (Typeable, typeOf)
@@ -186,6 +185,12 @@ instance FromField UTCTime where
 
   fromField f = returnError ConversionFailed f "expecting SQLText column type"
 
+instance FromField NominalDiffTime where
+  fromField fld = case fieldData fld of
+    (SQLFloat n) -> pure $ realToFrac n
+    _ -> err "expecting SQLInteger column type"
+    where
+    err = returnError ConversionFailed fld
 
 instance FromField Day where
   fromField f@(Field (SQLText t) _) =

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
@@ -30,19 +32,53 @@ import           Control.Monad (replicateM)
 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.16.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'
@@ -54,10 +90,30 @@ import           Database.SQLite.Simple.Types
 --
 -- Note the caveats associated with user-defined implementations of
 -- 'fromRow'.
-
+--
+-- === Generic implementation
+--
+-- Since version 0.4.16.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
     ncols <- asks nColumns

Database/SQLite/Simple/ToField.hs

@@ -25,7 +25,7 @@ import           Data.Int (Int8, Int16, Int32, Int64)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as LT
 import qualified Data.Text.Encoding as T
-import           Data.Time (Day, UTCTime)
+import           Data.Time (Day, UTCTime, NominalDiffTime)
 import           Data.Word (Word, Word8, Word16, Word32, Word64)
 import           GHC.Float
 
@@ -130,6 +130,9 @@ instance ToField LT.Text where
 
 instance ToField UTCTime where
     toField = SQLText . T.decodeUtf8 . toByteString . utcTimeToBuilder
+
+instance ToField NominalDiffTime where
+    toField = SQLFloat . realToFrac
     {-# INLINE toField #-}
 
 instance ToField Day where

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 _ = []
-
-instance (ToField a) => ToRow (Only a) where
-    toRow (Only v) = [toField v]
+-- | Generic derivation of 'ToRow'.  For details about what can be
+-- derived refer to 'Database.Sqlite.Simple.FromRow.GFromRow'.
+--
+-- @since 0.4.16.1
+class GToRow f where
+  gtoRow :: (f a) -> [SQLData]
 
-instance (ToField a, ToField b) => ToRow (a,b) where
-    toRow (a,b) = [toField a, toField b]
+instance GToRow U1 where
+  gtoRow U1 = toRow ()
 
-instance (ToField a, ToField b, ToField c) => ToRow (a,b,c) where
-    toRow (a,b,c) = [toField a, toField b, toField c]
+instance ToField a => GToRow (K1 i a) where
+  gtoRow (K1 a) = pure $ toField a
 
-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 b) => GToRow (a :*: b) where
+  gtoRow (a :*: b) = gtoRow a `mappend` gtoRow b
 
-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]
+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, 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]
+-- | A collection type that can be turned into a list of 'SQLData'
+-- elements.
+--
+-- Since version 0.4.16.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,
-          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]
+    default toRow :: Generic a => GToRow (Rep a) => a -> [SQLData]
+    toRow a = gtoRow $ from a
+
+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)

changelog

@@ -1,7 +1,13 @@
+0.4.16.2
+	* Add instance for {From,To}Field for NominalDiffTime
+
+0.4.16.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!)
 

sqlite-simple.cabal

@@ -1,5 +1,5 @@
 Name:                sqlite-simple
-Version:             0.4.16.0
+Version:             0.4.17.0
 Synopsis:            Mid-Level SQLite client library
 Description:
     Mid-level SQLite client library, based on postgresql-simple.

stack.yaml

@@ -1 +1 @@
-resolver: lts-11.9
+resolver: lts-12.0