diff --git a/composite-opaleye.cabal b/composite-opaleye.cabal --- a/composite-opaleye.cabal +++ b/composite-opaleye.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.17.0. +-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack name: composite-opaleye -version: 0.4.2.0 +version: 0.5.0.0 synopsis: Opaleye SQL for Frames records description: Integration between Frames records and Opaleye SQL, allowing records to be stored, retrieved, and queried from PostgreSQL. category: Records @@ -18,7 +18,7 @@ library hs-source-dirs: src - default-extensions: DataKinds FlexibleContexts FlexibleInstances LambdaCase MultiParamTypeClasses OverloadedStrings PolyKinds ScopedTypeVariables StrictData TemplateHaskell TypeFamilies TypeOperators ViewPatterns + default-extensions: DataKinds FlexibleContexts FlexibleInstances LambdaCase MultiParamTypeClasses OverloadedStrings PatternSynonyms PolyKinds ScopedTypeVariables StrictData TemplateHaskell TypeFamilies TypeOperators ViewPatterns ghc-options: -Wall -O2 build-depends: base >= 4.7 && < 5 @@ -37,5 +37,34 @@ Composite.Opaleye.ProductProfunctors Composite.Opaleye.RecordTable Composite.Opaleye.TH + Composite.Opaleye.Update Composite.Opaleye.Util + other-modules: + Paths_composite_opaleye + default-language: Haskell2010 + +test-suite composite-opaleye-test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + test + default-extensions: DataKinds FlexibleContexts FlexibleInstances LambdaCase MultiParamTypeClasses OverloadedStrings PatternSynonyms PolyKinds ScopedTypeVariables StrictData TemplateHaskell TypeFamilies TypeOperators ViewPatterns + ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N -fno-warn-orphans + build-depends: + base >= 4.7 && < 5 + , bytestring + , composite-base + , lens + , opaleye + , postgresql-simple + , product-profunctors + , profunctors + , template-haskell + , text + , vinyl + , QuickCheck + , composite-opaleye + , hspec + other-modules: + UpdateSpec default-language: Haskell2010 diff --git a/src/Composite/Opaleye.hs b/src/Composite/Opaleye.hs --- a/src/Composite/Opaleye.hs +++ b/src/Composite/Opaleye.hs @@ -1,7 +1,9 @@ module Composite.Opaleye ( module Composite.Opaleye.ProductProfunctors , module Composite.Opaleye.RecordTable + , module Composite.Opaleye.Update ) where import Composite.Opaleye.ProductProfunctors import Composite.Opaleye.RecordTable +import Composite.Opaleye.Update diff --git a/src/Composite/Opaleye/RecordTable.hs b/src/Composite/Opaleye/RecordTable.hs --- a/src/Composite/Opaleye/RecordTable.hs +++ b/src/Composite/Opaleye/RecordTable.hs @@ -36,10 +36,10 @@ -- -- Is equivalent to: -- --- > pReq (optional "id" &: required "name" &: Nil) +-- > pRec (optional "id" &: required "name" &: Nil) -- -- --- Alternately, use 'Composite.Opaleye.ProductProfunctors.pReq' and the usual Opaleye 'required' and 'optional'. +-- Alternately, use 'Composite.Opaleye.ProductProfunctors.pRec' and the usual Opaleye 'required' and 'optional'. class DefaultRecTable write read where defaultRecTable :: TableProperties (Rec Identity write) (Rec Identity read) diff --git a/src/Composite/Opaleye/Update.hs b/src/Composite/Opaleye/Update.hs new file mode 100644 --- /dev/null +++ b/src/Composite/Opaleye/Update.hs @@ -0,0 +1,34 @@ +-- |Module which provides utilities for processing updates using Opaleye and Composite +module Composite.Opaleye.Update + ( RecordToUpdate, recordToUpdate + ) where + +import Composite.Record ((:->)(Val), Rec((:&), RNil), Record) +import Data.Functor.Identity (Identity(Identity)) + +-- |Typeclass which allows transformation of a record from its select form to neutral update form, which boils down to wrapping fields that have defaults +-- with 'Just'. +class RecordToUpdate (rs :: [*]) (ss :: [*]) where + -- |Transform a @'Record' rs@ obtained from the database to a @'Record' ss@ representing an updated version of the row. + -- + -- Opaleye's @runUpdate@ family of functions all take an update function of the type @columnsR -> columnsW@, which this function implements generically + -- for a no-op update. + -- + -- Typically this function is composed with one or more lens @set@s which update the fields after the transformation. + recordToUpdate :: Record rs -> Record ss + +-- |For an empty record, just act as 'id'. +instance RecordToUpdate '[] '[] where + recordToUpdate RNil = RNil + {-# INLINE recordToUpdate #-} + +-- |For a field whose type doesn't change between selection and update, just pass the field unchanged and then recurse. +instance RecordToUpdate rs ss => RecordToUpdate (r ': rs) (r ': ss) where + recordToUpdate (r :& rs) = r :& recordToUpdate rs + {-# INLINE recordToUpdate #-} + +-- |For a field whose type at selection is @s :-> a@ but at update is @s :-> Maybe a@ (a field which has a default value) add in a 'Just' and recurse. +instance RecordToUpdate rs ss => RecordToUpdate (s :-> a ': rs) (s :-> Maybe a ': ss) where + recordToUpdate (Identity (Val a) :& rs) = Identity (Val (Just a)) :& recordToUpdate rs + {-# INLINE recordToUpdate #-} + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,7 @@ +import Test.Hspec (hspec) + +import UpdateSpec (updateSuite) + +main :: IO () +main = hspec $ do + updateSuite diff --git a/test/UpdateSpec.hs b/test/UpdateSpec.hs new file mode 100644 --- /dev/null +++ b/test/UpdateSpec.hs @@ -0,0 +1,50 @@ +module UpdateSpec where + +import Composite.Opaleye.Update (recordToUpdate) +import Composite.Record ((:->), Rec(RNil), Record, pattern (:*:)) +import Composite.TH (withLensesAndProxies) +import Test.Hspec (Spec, describe, it, shouldBe) + +withLensesAndProxies [d| + type FFoo = "foo" :-> Int + type FFooMay = "foo" :-> Maybe Int + type FBar = "bar" :-> String + type FBaz = "baz" :-> Maybe Double + type FBazMay = "baz" :-> Maybe (Maybe Double) + type FQux = "qux" :-> Maybe Bool + |] + +type ForSelect1 = '[] +type ForUpdate1 = '[] + +type ForSelect2 = '[FBar] +type ForUpdate2 = '[FBar] + +type ForSelect3 = '[FFoo] +type ForUpdate3 = '[FFooMay] + +type ForSelect4 = '[FFoo , FBar, FBaz , FQux] +type ForUpdate4 = '[FFooMay, FBar, FBazMay, FQux] + +type ForSelect5 = '[FBar, FFoo , FQux, FBaz ] +type ForUpdate5 = '[FBar, FFooMay, FQux, FBazMay] + +updateSuite :: Spec +updateSuite = do + describe "Composite.Opaleye.Update" $ do + it "should compute the update version of an empty record" $ do + recordToUpdate ( RNil :: Record ForSelect1) + `shouldBe` ( RNil :: Record ForUpdate1) + it "should compute the update version of a record with no defaulted fields" $ do + recordToUpdate ("hi" :*: RNil :: Record ForSelect2) + `shouldBe` ("hi" :*: RNil :: Record ForUpdate2) + it "should compute the update version of a record with a defaulted field" $ do + recordToUpdate ( 123 :*: RNil :: Record ForSelect3) + `shouldBe` (Just 123 :*: RNil :: Record ForUpdate3) + it "should compute the update version of a record with mixed fields" $ do + recordToUpdate ( 123 :*: "hi" :*: Nothing :*: Just True :*: RNil :: Record ForSelect4) + `shouldBe` (Just 123 :*: "hi" :*: Just Nothing :*: Just True :*: RNil :: Record ForUpdate4) + it "should compute the update version of a record with mixed fields and different ordering" $ do + recordToUpdate ("hi" :*: 123 :*: Just True :*: Nothing :*: RNil :: Record ForSelect5) + `shouldBe` ("hi" :*: Just 123 :*: Just True :*: Just Nothing :*: RNil :: Record ForUpdate5) +