From f3fc8c89068b6e34fbe680c000d33ab9999d03cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Mon, 23 Jul 2018 11:51:50 +0200 Subject: [PATCH 01/13] {To,From}Field for NominalDiffTime --- Database/SQLite/Simple/FromField.hs | 14 +++++++++++++- Database/SQLite/Simple/ToField.hs | 5 ++++- sqlite-simple.cabal | 2 +- 3 files changed, 18 insertions(+), 3 deletions(-) diff --git a/Database/SQLite/Simple/FromField.hs b/Database/SQLite/Simple/FromField.hs index e52dc1b..8d4e64d 100644 --- a/Database/SQLite/Simple/FromField.hs +++ b/Database/SQLite/Simple/FromField.hs @@ -40,9 +40,10 @@ 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 Text.Read (readEither) import Data.Typeable (Typeable, typeOf) import Data.Word (Word, Word8, Word16, Word32, Word64) import GHC.Float (double2Float) @@ -186,6 +187,17 @@ instance FromField UTCTime where fromField f = returnError ConversionFailed f "expecting SQLText column type" +parseNominalDiff :: T.Text -> Either String NominalDiffTime +parseNominalDiff = fmap fromInteger . readEither . T.unpack + +instance FromField NominalDiffTime where + fromField fld = case fieldData fld of + (SQLText t) -> case parseNominalDiff t of + Right tm -> pure tm + Left e -> err ("couldn't parse UTCTime field: " ++ e) + _ -> err "expecting SQLText column type" + where + err = returnError ConversionFailed fld instance FromField Day where fromField f@(Field (SQLText t) _) = diff --git a/Database/SQLite/Simple/ToField.hs b/Database/SQLite/Simple/ToField.hs index 194f383..4920e37 100644 --- a/Database/SQLite/Simple/ToField.hs +++ b/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 = SQLText . T.pack . show {-# INLINE toField #-} instance ToField Day where diff --git a/sqlite-simple.cabal b/sqlite-simple.cabal index 9f2aa73..b0dee9b 100644 --- a/sqlite-simple.cabal +++ b/sqlite-simple.cabal @@ -1,5 +1,5 @@ Name: sqlite-simple -Version: 0.4.16.0 +Version: 0.4.16.1 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple. From 403524ac7448bfeaa68c5a54ca067be53e762c73 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Fri, 27 Jul 2018 13:46:48 +0200 Subject: [PATCH 02/13] Also parse floats (rounded) `NominalDiffTime`'s (that only store seconds) --- Database/SQLite/Simple/FromField.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/Database/SQLite/Simple/FromField.hs b/Database/SQLite/Simple/FromField.hs index 8d4e64d..3c4eef7 100644 --- a/Database/SQLite/Simple/FromField.hs +++ b/Database/SQLite/Simple/FromField.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} ------------------------------------------------------------------------------ -- | @@ -187,15 +188,21 @@ instance FromField UTCTime where fromField f = returnError ConversionFailed f "expecting SQLText column type" -parseNominalDiff :: T.Text -> Either String NominalDiffTime -parseNominalDiff = fmap fromInteger . readEither . T.unpack +-- TODO In `time >= 1.9.1` we can do (at least a bit) better because +-- we can construct 'NominalDiffTime''s using +-- @secondsToNominalDiffTime@ - this still doesn't take into acount +-- rounded numbers - but `NominalDiffTime` doesn't seem to allow that. +floatToTime :: Double -> NominalDiffTime +floatToTime = fromInteger . round + +integerToTime :: Int64 -> NominalDiffTime +integerToTime = fromInteger @NominalDiffTime . toInteger instance FromField NominalDiffTime where fromField fld = case fieldData fld of - (SQLText t) -> case parseNominalDiff t of - Right tm -> pure tm - Left e -> err ("couldn't parse UTCTime field: " ++ e) - _ -> err "expecting SQLText column type" + (SQLFloat n) -> pure $ floatToTime n + (SQLInteger n) -> pure $ integerToTime n + _ -> err "expecting SQLFloat column type" where err = returnError ConversionFailed fld From 3892d993b2eba63dbf0f013585bbb872e9789bdf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Thu, 27 Sep 2018 17:44:37 +0200 Subject: [PATCH 03/13] Dataype generic implementation of {From,To}Row This is my first time ever doing data-type generic programming, so please review this carefully. I conferred with the documentation in base[1] and I also looked at the analoguous definition in the package `binary`[2]. It was surprisingly easy to implement, but perhaps it should be tested some more before merging in. I've just quickly tested it with the code-base I'm working on. Note that it the current implementation can only derive the generic instance for product-types (not sum-types). [1]: http://hackage.haskell.org/package/base-4.12.0.0/docs/GHC-Generics.html#g:10 [2]: http://hackage.haskell.org/package/binary --- Database/SQLite/Simple/FromRow.hs | 31 +++++++++++++++++++++++++++++-- Database/SQLite/Simple/ToRow.hs | 31 +++++++++++++++++++++++++++++-- sqlite-simple.cabal | 2 +- stack.yaml | 2 +- 4 files changed, 60 insertions(+), 6 deletions(-) diff --git a/Database/SQLite/Simple/FromRow.hs b/Database/SQLite/Simple/FromRow.hs index 781e8c1..e0b9552 100644 --- a/Database/SQLite/Simple/FromRow.hs +++ b/Database/SQLite/Simple/FromRow.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, DefaultSignatures, FlexibleContexts #-} ------------------------------------------------------------------------------ -- | @@ -17,7 +17,8 @@ ------------------------------------------------------------------------------ module Database.SQLite.Simple.FromRow - ( FromRow(..) + ( GFromRow(..) + , FromRow(..) , RowParser , field , fieldWith @@ -30,12 +31,32 @@ 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 implementation of '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. -- @@ -58,6 +79,12 @@ import Database.SQLite.Simple.Types class FromRow a where fromRow :: RowParser a + -- | Generic implementation of 'FromRow'. + -- + -- @since 0.4.16.1@ + default fromRow :: Generic a => GFromRow (Rep a) => RowParser a + fromRow = to <$> gfromRow + fieldWith :: FieldParser a -> RowParser a fieldWith fieldP = RP $ do ncols <- asks nColumns diff --git a/Database/SQLite/Simple/ToRow.hs b/Database/SQLite/Simple/ToRow.hs index 60e07f3..b5fb3b5 100644 --- a/Database/SQLite/Simple/ToRow.hs +++ b/Database/SQLite/Simple/ToRow.hs @@ -1,3 +1,4 @@ +{-# Language DefaultSignatures, FlexibleContexts #-} ------------------------------------------------------------------------------ -- | -- Module: Database.SQLite.Simple.ToRow @@ -17,21 +18,47 @@ ------------------------------------------------------------------------------ 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(..)) +-- | Generic implementation of 'ToRow'. +-- +-- @since 0.4.16.1 +class GToRow f where + gtoRow :: (f a) -> [SQLData] + +instance GToRow U1 where + gtoRow U1 = toRow () + +instance ToField a => GToRow (K1 i a) where + gtoRow (K1 a) = pure $ toField a + +instance (GToRow a, GToRow b) => GToRow (a :*: b) where + gtoRow (a :*: b) = gtoRow a <> gtoRow b + +instance GToRow a => GToRow (M1 i c a) where + gtoRow (M1 a) = gtoRow a + -- | 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. + -- | Generic implementation of 'ToRow'. + -- + -- @since 0.4.16.1@ + default toRow :: Generic a => GToRow (Rep a) => a -> [SQLData] + toRow a = gtoRow $ from a + instance ToRow () where toRow _ = [] diff --git a/sqlite-simple.cabal b/sqlite-simple.cabal index 9f2aa73..b0dee9b 100644 --- a/sqlite-simple.cabal +++ b/sqlite-simple.cabal @@ -1,5 +1,5 @@ Name: sqlite-simple -Version: 0.4.16.0 +Version: 0.4.16.1 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple. diff --git a/stack.yaml b/stack.yaml index c332fca..3c8f1b1 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1 @@ -resolver: lts-11.9 +resolver: lts-12.0 From c5f2bfd9aee486e7f8dae0993447f3a7faa78bc5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Thu, 27 Sep 2018 17:59:13 +0200 Subject: [PATCH 04/13] Generic derivation of instance for tuples This may be less of an interesting change... --- Database/SQLite/Simple/ToRow.hs | 42 ++++++++------------------------- 1 file changed, 10 insertions(+), 32 deletions(-) diff --git a/Database/SQLite/Simple/ToRow.hs b/Database/SQLite/Simple/ToRow.hs index b5fb3b5..3e6eadd 100644 --- a/Database/SQLite/Simple/ToRow.hs +++ b/Database/SQLite/Simple/ToRow.hs @@ -1,4 +1,5 @@ -{-# Language DefaultSignatures, FlexibleContexts #-} +{-# Language DefaultSignatures, FlexibleContexts, DerivingStrategies, + DeriveAnyClass #-} ------------------------------------------------------------------------------ -- | -- Module: Database.SQLite.Simple.ToRow @@ -59,37 +60,14 @@ class ToRow a where default toRow :: Generic a => GToRow (Rep a) => a -> [SQLData] toRow a = gtoRow $ from a -instance ToRow () where - toRow _ = [] - -instance (ToField a) => ToRow (Only a) where - toRow (Only v) = [toField v] - -instance (ToField a, ToField b) => ToRow (a,b) where - toRow (a,b) = [toField a, toField b] - -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, 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 (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 (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] - -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 anyclass instance ToRow () +deriving anyclass instance (ToField a) => ToRow (Only a) +deriving anyclass instance (ToField a, ToField b) => ToRow (a,b) +deriving anyclass instance (ToField a, ToField b, ToField c) => ToRow (a,b,c) +deriving anyclass instance (ToField a, ToField b, ToField c, ToField d) => ToRow (a,b,c,d) +deriving anyclass instance (ToField a, ToField b, ToField c, ToField d, ToField e) => ToRow (a,b,c,d,e) +deriving anyclass instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) => ToRow (a,b,c,d,e,f) +deriving anyclass 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) From 6984c9d481b472e492b90eca5f25fa86068fa15f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Thu, 27 Sep 2018 18:04:28 +0200 Subject: [PATCH 05/13] Fix haddock syntax error --- Database/SQLite/Simple/FromRow.hs | 2 +- Database/SQLite/Simple/ToRow.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Database/SQLite/Simple/FromRow.hs b/Database/SQLite/Simple/FromRow.hs index e0b9552..a2e3903 100644 --- a/Database/SQLite/Simple/FromRow.hs +++ b/Database/SQLite/Simple/FromRow.hs @@ -81,7 +81,7 @@ class FromRow a where -- | Generic implementation of 'FromRow'. -- - -- @since 0.4.16.1@ + -- @since 0.4.16.1 default fromRow :: Generic a => GFromRow (Rep a) => RowParser a fromRow = to <$> gfromRow diff --git a/Database/SQLite/Simple/ToRow.hs b/Database/SQLite/Simple/ToRow.hs index 3e6eadd..fea8d09 100644 --- a/Database/SQLite/Simple/ToRow.hs +++ b/Database/SQLite/Simple/ToRow.hs @@ -56,7 +56,7 @@ class ToRow a where -- | Generic implementation of 'ToRow'. -- - -- @since 0.4.16.1@ + -- @since 0.4.16.1 default toRow :: Generic a => GToRow (Rep a) => a -> [SQLData] toRow a = gtoRow $ from a From c6236bf69e7e9ccd361a43116408ce960fadb581 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Thu, 27 Sep 2018 18:05:15 +0200 Subject: [PATCH 06/13] Whoopsie! Requires -XStandaloneDeriving --- Database/SQLite/Simple/FromRow.hs | 3 ++- Database/SQLite/Simple/ToRow.hs | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/Database/SQLite/Simple/FromRow.hs b/Database/SQLite/Simple/FromRow.hs index a2e3903..f87bc5e 100644 --- a/Database/SQLite/Simple/FromRow.hs +++ b/Database/SQLite/Simple/FromRow.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE RecordWildCards, DefaultSignatures, FlexibleContexts #-} +{-# LANGUAGE RecordWildCards, DefaultSignatures, FlexibleContexts, + StandaloneDeriving #-} ------------------------------------------------------------------------------ -- | diff --git a/Database/SQLite/Simple/ToRow.hs b/Database/SQLite/Simple/ToRow.hs index fea8d09..a348976 100644 --- a/Database/SQLite/Simple/ToRow.hs +++ b/Database/SQLite/Simple/ToRow.hs @@ -1,5 +1,5 @@ {-# Language DefaultSignatures, FlexibleContexts, DerivingStrategies, - DeriveAnyClass #-} + DeriveAnyClass, StandaloneDeriving #-} ------------------------------------------------------------------------------ -- | -- Module: Database.SQLite.Simple.ToRow From b923c8bbc8bd39a196530860670232e69263c690 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Tue, 9 Oct 2018 12:10:05 +0200 Subject: [PATCH 07/13] Use {From,To}Enum for implementing {From,To}Field for NominalDiffTime. --- Database/SQLite/Simple/FromField.hs | 17 ++--------------- Database/SQLite/Simple/ToField.hs | 2 +- changelog | 5 ++++- sqlite-simple.cabal | 2 +- 4 files changed, 8 insertions(+), 18 deletions(-) diff --git a/Database/SQLite/Simple/FromField.hs b/Database/SQLite/Simple/FromField.hs index 3c4eef7..0596cc7 100644 --- a/Database/SQLite/Simple/FromField.hs +++ b/Database/SQLite/Simple/FromField.hs @@ -35,7 +35,6 @@ 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 @@ -44,7 +43,6 @@ import Data.Int (Int8, Int16, Int32, Int64) import Data.Time (UTCTime, Day, NominalDiffTime) import qualified Data.Text as T import qualified Data.Text.Lazy as LT -import Text.Read (readEither) import Data.Typeable (Typeable, typeOf) import Data.Word (Word, Word8, Word16, Word32, Word64) import GHC.Float (double2Float) @@ -188,21 +186,10 @@ instance FromField UTCTime where fromField f = returnError ConversionFailed f "expecting SQLText column type" --- TODO In `time >= 1.9.1` we can do (at least a bit) better because --- we can construct 'NominalDiffTime''s using --- @secondsToNominalDiffTime@ - this still doesn't take into acount --- rounded numbers - but `NominalDiffTime` doesn't seem to allow that. -floatToTime :: Double -> NominalDiffTime -floatToTime = fromInteger . round - -integerToTime :: Int64 -> NominalDiffTime -integerToTime = fromInteger @NominalDiffTime . toInteger - instance FromField NominalDiffTime where fromField fld = case fieldData fld of - (SQLFloat n) -> pure $ floatToTime n - (SQLInteger n) -> pure $ integerToTime n - _ -> err "expecting SQLFloat column type" + (SQLInteger n) -> pure $ toEnum $ fromEnum n + _ -> err "expecting SQLInteger column type" where err = returnError ConversionFailed fld diff --git a/Database/SQLite/Simple/ToField.hs b/Database/SQLite/Simple/ToField.hs index 4920e37..907069e 100644 --- a/Database/SQLite/Simple/ToField.hs +++ b/Database/SQLite/Simple/ToField.hs @@ -132,7 +132,7 @@ instance ToField UTCTime where toField = SQLText . T.decodeUtf8 . toByteString . utcTimeToBuilder instance ToField NominalDiffTime where - toField = SQLText . T.pack . show + toField = SQLInteger . toEnum . fromEnum {-# INLINE toField #-} instance ToField Day where diff --git a/changelog b/changelog index 2a5a649..91bceee 100644 --- a/changelog +++ b/changelog @@ -1,7 +1,10 @@ +0.4.16.2 + * Add instance for {From,To}Field for NominalDiffTime + 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 index b0dee9b..59230f4 100644 --- a/sqlite-simple.cabal +++ b/sqlite-simple.cabal @@ -1,5 +1,5 @@ Name: sqlite-simple -Version: 0.4.16.1 +Version: 0.4.16.2 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple. From fd4aa7980c30624cecabb81de506d6c2f17fb1b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Tue, 9 Oct 2018 20:28:48 +0200 Subject: [PATCH 08/13] Store NominalDiffTime as floats --- Database/SQLite/Simple/FromField.hs | 2 +- Database/SQLite/Simple/ToField.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Database/SQLite/Simple/FromField.hs b/Database/SQLite/Simple/FromField.hs index 0596cc7..0317a78 100644 --- a/Database/SQLite/Simple/FromField.hs +++ b/Database/SQLite/Simple/FromField.hs @@ -188,7 +188,7 @@ instance FromField UTCTime where instance FromField NominalDiffTime where fromField fld = case fieldData fld of - (SQLInteger n) -> pure $ toEnum $ fromEnum n + (SQLFloat n) -> pure $ realToFrac n _ -> err "expecting SQLInteger column type" where err = returnError ConversionFailed fld diff --git a/Database/SQLite/Simple/ToField.hs b/Database/SQLite/Simple/ToField.hs index 907069e..c76b72e 100644 --- a/Database/SQLite/Simple/ToField.hs +++ b/Database/SQLite/Simple/ToField.hs @@ -132,7 +132,7 @@ instance ToField UTCTime where toField = SQLText . T.decodeUtf8 . toByteString . utcTimeToBuilder instance ToField NominalDiffTime where - toField = SQLInteger . toEnum . fromEnum + toField = SQLFloat . realToFrac {-# INLINE toField #-} instance ToField Day where From dbb821280cdb5b60172d366c8ede9c83e7686cef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Tue, 9 Oct 2018 20:40:32 +0200 Subject: [PATCH 09/13] Update haddock comment and changelog --- Database/SQLite/Simple/FromRow.hs | 40 ++++++++++++++++++++++++++----- Database/SQLite/Simple/ToRow.hs | 11 +++++---- changelog | 3 +++ 3 files changed, 44 insertions(+), 10 deletions(-) diff --git a/Database/SQLite/Simple/FromRow.hs b/Database/SQLite/Simple/FromRow.hs index f87bc5e..297c77a 100644 --- a/Database/SQLite/Simple/FromRow.hs +++ b/Database/SQLite/Simple/FromRow.hs @@ -40,7 +40,20 @@ import Database.SQLite.Simple.Ok import Database.SQLite.Simple.Types --- | Generic implementation of 'FromRow'. +-- | 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 @@ -64,7 +77,8 @@ instance (GFromRow a, GFromRow b) => GFromRow (a :*: b) where -- 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' @@ -76,13 +90,27 @@ instance (GFromRow a, GFromRow b) => GFromRow (a :*: b) where -- -- 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 - -- | Generic implementation of 'FromRow'. - -- - -- @since 0.4.16.1 default fromRow :: Generic a => GFromRow (Rep a) => RowParser a fromRow = to <$> gfromRow diff --git a/Database/SQLite/Simple/ToRow.hs b/Database/SQLite/Simple/ToRow.hs index a348976..14748a5 100644 --- a/Database/SQLite/Simple/ToRow.hs +++ b/Database/SQLite/Simple/ToRow.hs @@ -30,7 +30,8 @@ import Database.SQLite.Simple.Types (Only(..), (:.)(..)) import Database.SQLite3 (SQLData(..)) --- | Generic implementation of 'ToRow'. +-- | 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 @@ -50,13 +51,15 @@ instance GToRow a => GToRow (M1 i c a) where -- | 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. - -- | Generic implementation of 'ToRow'. - -- - -- @since 0.4.16.1 default toRow :: Generic a => GToRow (Rep a) => a -> [SQLData] toRow a = gtoRow $ from a diff --git a/changelog b/changelog index 91bceee..bbc3c9b 100644 --- a/changelog +++ b/changelog @@ -1,6 +1,9 @@ 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) From 410d8223d3e8082fdf1c38fbc60e69c3c21d4262 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Tue, 9 Oct 2018 22:45:57 +0200 Subject: [PATCH 10/13] Bump version number --- sqlite-simple.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sqlite-simple.cabal b/sqlite-simple.cabal index 59230f4..f87fa09 100644 --- a/sqlite-simple.cabal +++ b/sqlite-simple.cabal @@ -1,5 +1,5 @@ Name: sqlite-simple -Version: 0.4.16.2 +Version: 0.4.17.0 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple. From acff535a9159963907b6e8ca2b6efb214e4b6873 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Thu, 18 Oct 2018 15:43:49 +0200 Subject: [PATCH 11/13] Remove unused TypeApplications pragma --- Database/SQLite/Simple/FromField.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/Database/SQLite/Simple/FromField.hs b/Database/SQLite/Simple/FromField.hs index 0317a78..6050017 100644 --- a/Database/SQLite/Simple/FromField.hs +++ b/Database/SQLite/Simple/FromField.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} ------------------------------------------------------------------------------ -- | From 5180f683ea15e1191455ed12d452bf0c4e5358a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Thu, 18 Oct 2018 15:36:51 +0200 Subject: [PATCH 12/13] Do not use -XDerivingStrategies --- Database/SQLite/Simple/ToRow.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Database/SQLite/Simple/ToRow.hs b/Database/SQLite/Simple/ToRow.hs index 14748a5..6ce9949 100644 --- a/Database/SQLite/Simple/ToRow.hs +++ b/Database/SQLite/Simple/ToRow.hs @@ -1,5 +1,5 @@ -{-# Language DefaultSignatures, FlexibleContexts, DerivingStrategies, - DeriveAnyClass, StandaloneDeriving #-} +{-# Language DefaultSignatures, FlexibleContexts, DeriveAnyClass, + StandaloneDeriving #-} ------------------------------------------------------------------------------ -- | -- Module: Database.SQLite.Simple.ToRow @@ -63,14 +63,14 @@ class ToRow a where default toRow :: Generic a => GToRow (Rep a) => a -> [SQLData] toRow a = gtoRow $ from a -deriving anyclass instance ToRow () -deriving anyclass instance (ToField a) => ToRow (Only a) -deriving anyclass instance (ToField a, ToField b) => ToRow (a,b) -deriving anyclass instance (ToField a, ToField b, ToField c) => ToRow (a,b,c) -deriving anyclass instance (ToField a, ToField b, ToField c, ToField d) => ToRow (a,b,c,d) -deriving anyclass instance (ToField a, ToField b, ToField c, ToField d, ToField e) => ToRow (a,b,c,d,e) -deriving anyclass instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) => ToRow (a,b,c,d,e,f) -deriving anyclass instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g) => ToRow (a,b,c,d,e,f,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) From d43ea0e8b24c46afe8d8d20f947bce33994ddd43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= Date: Thu, 18 Oct 2018 15:48:00 +0200 Subject: [PATCH 13/13] Use mappend in stead of <> --- Database/SQLite/Simple/ToRow.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Database/SQLite/Simple/ToRow.hs b/Database/SQLite/Simple/ToRow.hs index 6ce9949..6e3e3e1 100644 --- a/Database/SQLite/Simple/ToRow.hs +++ b/Database/SQLite/Simple/ToRow.hs @@ -44,7 +44,7 @@ instance ToField a => GToRow (K1 i a) where gtoRow (K1 a) = pure $ toField a instance (GToRow a, GToRow b) => GToRow (a :*: b) where - gtoRow (a :*: b) = gtoRow a <> gtoRow b + gtoRow (a :*: b) = gtoRow a `mappend` gtoRow b instance GToRow a => GToRow (M1 i c a) where gtoRow (M1 a) = gtoRow a