composite-opaleye 0.8.0.0 → 0.8.1.0
raw patch · 3 files changed
+77/−7 lines, 3 filesdep +splitPVP ok
version bump matches the API change (PVP)
Dependencies added: split
API changes (from Hackage documentation)
+ Composite.Opaleye.TH: getLastComponent :: String -> String
Files
- composite-opaleye.cabal +4/−4
- src/Composite/Opaleye/RecordTable.hs +64/−1
- src/Composite/Opaleye/TH.hs +9/−2
composite-opaleye.cabal view
@@ -3,15 +3,13 @@ -- This file has been generated from package.yaml by hpack version 0.34.5. -- -- see: https://github.com/sol/hpack------ hash: 03ab7de21f52bc22bd073870d37886f0591c8fa2ee7a704f32d4e385ecbcc622 name: composite-opaleye-version: 0.8.0.0+version: 0.8.1.0 synopsis: Opaleye SQL for Vinyl records description: Integration between Vinyl records and Opaleye SQL, allowing records to be stored, retrieved, and queried from PostgreSQL. category: Records-homepage: https://github.com/ConferOpenSource/composite#readme+homepage: https://github.com/composite-hs/composite#readme author: Confer Health, Inc. maintainer: oss@vitalbio.com copyright: 2017 Confer Health, Inc., 2020-2021 Vital Biosciences@@ -55,6 +53,7 @@ , postgresql-simple >=0.5.3.0 && <0.7 , product-profunctors >=0.8.0.3 && <0.12 , profunctors >=5.2.1 && <5.7+ , split >=0.2.3 && <0.3 , template-haskell >=2.11.1.0 && <2.19 , text >=1.2.2.2 && <1.3 , vinyl >=0.5.3 && <0.15@@ -96,6 +95,7 @@ , postgresql-simple >=0.5.3.0 && <0.7 , product-profunctors >=0.8.0.3 && <0.12 , profunctors >=5.2.1 && <5.7+ , split >=0.2.3 && <0.3 , template-haskell >=2.11.1.0 && <2.19 , text >=1.2.2.2 && <1.3 , vinyl >=0.5.3 && <0.15
src/Composite/Opaleye/RecordTable.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Composite.Opaleye.RecordTable where import Composite.Record ((:->)(Val), Rec((:&), RNil))@@ -7,9 +8,15 @@ import qualified Data.Profunctor.Product as PP import Data.Proxy (Proxy(Proxy)) import GHC.TypeLits (KnownSymbol, symbolVal)+#if MIN_VERSION_opaleye(0,8,0) import Opaleye (Field, requiredTableField, optionalTableField) import Opaleye.Internal.Table (TableFields)+#else+import Opaleye (Column, required, optional)+import Opaleye.Internal.Table (TableProperties)+#endif +#if MIN_VERSION_opaleye(0,8,0) -- |Helper typeclass which picks which of 'requiredTableField' or 'optionalTableField' to use for a pair of write column type and read column type. -- -- @DefaultRecTableField (Maybe (Field a)) (Field a)@ uses 'optionalTableField'.@@ -22,9 +29,24 @@ instance DefaultRecTableField (Field a) (Field a) where defaultRecTableField = requiredTableField+#else+-- |Helper typeclass which picks which of 'required' or 'optional' to use for a pair of write column type and read column type.+--+-- @DefaultRecTableField (Maybe (Column a)) (Column a)@ uses 'optional'.+-- @DefaultRecTableField (Column a) (Column a)@ uses 'required'.+class DefaultRecTableField write read where+ defaultRecTableField :: String -> TableProperties write read +instance DefaultRecTableField (Maybe (Column a)) (Column a) where+ defaultRecTableField = optional++instance DefaultRecTableField (Column a) (Column a) where+ defaultRecTableField = required+#endif++#if MIN_VERSION_opaleye(0,8,0) -- |Type class for producing a default 'TableFields' schema for some expected record types. 'requiredTableField' and 'optionalTableField' are chosen automatically and the--- column is named after the record fields, using 'NamedField' to reflect the field names.+-- column is named after the record fields. -- -- For example, given: --@@ -62,3 +84,44 @@ step = defaultRecTableField $ symbolVal (Proxy :: Proxy s) recur :: TableFields (Rec Identity writes) (Rec Identity reads) recur = defaultRecTable+#else+-- |Type class for producing a default 'TableProperties' schema for some expected record types. 'required' and 'optional' are chosen automatically and the+-- column is named after the record fields.+--+-- For example, given:+--+-- > type WriteRec = Record '["id" :-> Maybe (Column PGInt8), "name" :-> Column PGText]+-- > type ReadRec = Record '["id" :-> Column PGInt8 , "name" :-> Column PGText]+--+-- This:+--+-- > defaultRecTable :: TableProperties WriteRec ReadRec+--+-- Is equivalent to:+--+-- > pRec (optional "id" &: required "name" &: Nil)+--+--+-- 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)++instance DefaultRecTable '[] '[] where+ defaultRecTable = dimap (const ()) (const RNil) PP.empty++instance+ forall s r reads w writes.+ ( KnownSymbol s+ , DefaultRecTableField w r+ , DefaultRecTable writes reads+ ) => DefaultRecTable (s :-> w ': writes) (s :-> r ': reads) where+ defaultRecTable =+ dimap (\ (Identity (Val w) :& writeRs) -> (w, writeRs))+ (\ (r, readRs) -> (Identity (Val r) :& readRs))+ (step ***! recur)+ where+ step :: TableProperties w r+ step = defaultRecTableField $ symbolVal (Proxy :: Proxy s)+ recur :: TableProperties (Rec Identity writes) (Rec Identity reads)+ recur = defaultRecTable+#endif
src/Composite/Opaleye/TH.hs view
@@ -3,6 +3,7 @@ import Control.Lens ((<&>)) import qualified Data.ByteString.Char8 as BSC8+import Data.List.Split (splitOn) import Data.Maybe (fromMaybe) import Data.Profunctor.Product.Default (Default, def) import Data.Traversable (for)@@ -27,6 +28,11 @@ import Opaleye.Internal.PGTypes (IsSqlType, showSqlType, literalColumn) import Opaleye.Internal.HaskellDB.PrimQuery (Literal(StringLit)) +getLastComponent :: String -> String+getLastComponent str = case reverse (splitOn "." str) of+ x:_ -> x+ [] -> str+ -- |Derive the various instances required to make a Haskell enumeration map to a PostgreSQL @enum@ type. -- -- In @deriveOpaleyeEnum ''HaskellType "schema.sqltype" hsConToSqlValue@, @''HaskellType@ is the sum type (data declaration) to make instances for, @@ -67,7 +73,7 @@ -- 'fromField' f mbs = do -- tname <- 'typename' f -- case mbs of--- _ | tname /= "myenum" -> 'returnError' 'Incompatible' f ""+-- _ | 'getLastComponent' ('BSC8.unpack' tname) /= "myenum" -> 'returnError' 'Incompatible' f "" -- Just "foo" -> pure MyFoo -- Just "bar" -> pure MyBar -- Just other -> 'returnError' 'ConversionFailed' f ("Unexpected myschema.myenum value: " <> 'BSC8.unpack' other)@@ -87,6 +93,7 @@ let sqlTypeName = mkName $ "PG" ++ nameBase hsName sqlType = conT sqlTypeName hsType = conT hsName+ unqualSqlName = getLastComponent sqlName rawCons <- reify hsName >>= \ case TyConI (DataD _cxt _name _tvVarBndrs _maybeKind cons _derivingCxt) ->@@ -133,7 +140,7 @@ let bodyCase = caseE (varE mbs) $ [ match wildP- (guardedB [ normalGE [| $(varE tname) /= $(lift sqlName) |]+ (guardedB [ normalGE [| getLastComponent (BSC8.unpack $(varE tname)) /= $(lift unqualSqlName) |] [| returnError Incompatible $(varE field) "" |] ]) [] ] ++