seakale 0.1.0.0 → 0.2.0.0
raw patch · 6 files changed
+45/−34 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Database.Seakale.Store.Internal: buildCondition :: ByteString -> (backend -> Vector n Column) -> (backend -> QueryData n) -> Condition backend a
+ Database.Seakale.Store.Internal: buildCondition :: ByteString -> ByteString -> (backend -> Vector n Column) -> (backend -> QueryData n) -> Condition backend a
- Database.Seakale.Types: type QueryData n = Vector n ByteString
+ Database.Seakale.Types: type QueryData n = Vector n (Maybe ByteString)
Files
- ChangeLog.md +4/−0
- seakale.cabal +2/−2
- src/Database/Seakale/Store.hs +11/−10
- src/Database/Seakale/Store/Internal.hs +12/−7
- src/Database/Seakale/ToRow.hs +13/−13
- src/Database/Seakale/Types.hs +3/−2
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for seakale +## 0.2.0.0 -- 2017-02-23++* Fix a bug with conditions such as `col = NULL` instead of `col IS NULL`+ ## 0.1.0.0 -- 2017-01-31 * First version.
seakale.cabal view
@@ -1,5 +1,5 @@ name: seakale-version: 0.1.0.0+version: 0.2.0.0 synopsis: Pure SQL layer on top of other libraries description: This library allows you to write pure code doing operations on a SQL databases. It can therefore be tested by mocking the database with the package 'seakale-tests'. To run it of a specific database, you need another package such as 'seakale-postgresql'. license: BSD3@@ -14,7 +14,7 @@ source-repository head type: darcs location: http://darcs.redspline.com/seakale- tag: 0.1.0.0+ tag: 0.2.0.0 library ghc-options: -Wall
src/Database/Seakale/Store.hs view
@@ -210,32 +210,32 @@ (==.) :: (Property backend a f, ToRow backend n b) => f backend n b -> b -> Condition backend a (==.) prop vals =- buildCondition "=" (flip toColumns prop) (flip toRow vals)+ buildCondition "=" "IS" (flip toColumns prop) (flip toRow vals) (/=.) :: (Property backend a f, ToRow backend n b) => f backend n b -> b -> Condition backend a (/=.) prop vals =- buildCondition "<>" (flip toColumns prop) (flip toRow vals)+ buildCondition "<>" "IS NOT" (flip toColumns prop) (flip toRow vals) (<=.) :: (Property backend a f, ToRow backend n b) => f backend n b -> b -> Condition backend a (<=.) prop vals =- buildCondition "<=" (flip toColumns prop) (flip toRow vals)+ buildCondition "<=" "<=" (flip toColumns prop) (flip toRow vals) (<.) :: (Property backend a f, ToRow backend n b) => f backend n b -> b -> Condition backend a (<.) prop vals =- buildCondition "<" (flip toColumns prop) (flip toRow vals)+ buildCondition "<" "<" (flip toColumns prop) (flip toRow vals) (>=.) :: (Property backend a f, ToRow backend n b) => f backend n b -> b -> Condition backend a (>=.) prop vals =- buildCondition ">=" (flip toColumns prop) (flip toRow vals)+ buildCondition ">=" ">=" (flip toColumns prop) (flip toRow vals) (>.) :: (Property backend a f, ToRow backend n b) => f backend n b -> b -> Condition backend a (>.) cols vals =- buildCondition ">" (flip toColumns cols) (flip toRow vals)+ buildCondition ">" ">" (flip toColumns cols) (flip toRow vals) (==#) :: (Property backend a f, Property backend a g) => f backend n b -> g backend n b -> Condition backend a@@ -328,9 +328,10 @@ let step value (suffix, (Condition f)) = (", ",) $ Condition $ \prefix backend -> let (req, dat) = f prefix backend- valueList = mconcat $ intersperse ", " $ vectorToList $- toRow backend value- in (Hole (Plain suffix req), Cons ("(" <> valueList <> ")") dat)+ valueList = mconcat $ intersperse ", " $ map (fromMaybe "NULL") $+ vectorToList $ toRow backend value+ in ( Hole (Plain suffix req)+ , Cons (Just ("(" <> valueList <> ")")) dat ) (_, cond) = foldr step ("", mempty) values @@ -375,4 +376,4 @@ (=.) :: (Property backend a f, ToRow backend n b) => f backend n b -> b -> UpdateSetter backend a (=.) col value = UpdateSetter $ \backend ->- vzip (toColumns backend col) (toRow backend value)+ vzip (toColumns backend col) (fmap (fromMaybe "NULL") $ toRow backend value)
src/Database/Seakale/Store/Internal.hs view
@@ -100,16 +100,21 @@ `qappend` Plain (" " <> op <> " ") (parenthesiseQuery q2) in (q, qdat1 `vappend` qdat2) -buildCondition :: BS.ByteString -> (backend -> Vector n Column)+buildCondition :: BS.ByteString -> BS.ByteString -> (backend -> Vector n Column) -> (backend -> QueryData n) -> Condition backend a-buildCondition op vec dat =+buildCondition op op' vec dat = Condition $ \prefix backend ->- (go id (fmap (($ prefix) . unColumn) (vec backend)), dat backend)+ let dat' = dat backend+ cols = fmap (($ prefix) . unColumn) (vec backend)+ req = go id cols dat'+ in (req, dat') where- go :: (forall m. Query m -> Query m) -> Vector n BS.ByteString -> Query n- go _ Nil = EmptyQuery- go f (Cons x xs) =- f $ Plain (x <> " " <> op <> " ") $ Hole $ go (Plain " AND ") xs+ go :: (forall m. Query m -> Query m) -> Vector n BS.ByteString+ -> QueryData n -> Query n+ go _ Nil Nil = EmptyQuery+ go f (Cons x xs) (Cons mBS dat') =+ f $ Plain (x <> " " <> maybe op' (const op) mBS <> " ") $+ Hole $ go (Plain " AND ") xs dat' buildCondition' :: BS.ByteString -> (backend -> Vector n Column) -> (backend -> Vector n Column)
src/Database/Seakale/ToRow.hs view
@@ -106,7 +106,7 @@ data ValueProxy con (K1 i a) b = ProxyConst (Maybe a) toValueProxy _ _ = ProxyConst . fmap unK1 gtoRow backend _ = (,Nothing) . \case- ProxyConst Nothing -> ntimes "NULL"+ ProxyConst Nothing -> ntimes Nothing ProxyConst (Just x) -> toRow backend x instance (Constructor c, GToRow backend con n a)@@ -136,10 +136,10 @@ instance ToRow backend Zero () instance ToRow backend One Null where- toRow _ Null = ["NULL"]+ toRow _ Null = [Nothing] -formatString :: BS.ByteString -> BS.ByteString-formatString str = "'" <> escapeQuotes "" str <> "'"+formatString :: BS.ByteString -> Maybe BS.ByteString+formatString str = Just $ "'" <> escapeQuotes "" str <> "'" where escapeQuotes :: BS.ByteString -> BS.ByteString -> BS.ByteString escapeQuotes _ "" = ""@@ -160,33 +160,33 @@ toRow _ s = [formatString $ TE.encodeUtf8 $ TL.toStrict s] instance ToRow backend One Int where- toRow _ n = [BS.pack $ show n]+ toRow _ n = [Just $ BS.pack $ show n] instance ToRow backend One Int8 where- toRow _ n = [BS.pack $ show n]+ toRow _ n = [Just $ BS.pack $ show n] instance ToRow backend One Int16 where- toRow _ n = [BS.pack $ show n]+ toRow _ n = [Just $ BS.pack $ show n] instance ToRow backend One Int32 where- toRow _ n = [BS.pack $ show n]+ toRow _ n = [Just $ BS.pack $ show n] instance ToRow backend One Int64 where- toRow _ n = [BS.pack $ show n]+ toRow _ n = [Just $ BS.pack $ show n] instance ToRow backend One Integer where- toRow _ n = [BS.pack $ show n]+ toRow _ n = [Just $ BS.pack $ show n] instance ToRow backend One Double where- toRow _ n = [BS.pack $ show n]+ toRow _ n = [Just $ BS.pack $ show n] instance ToRow backend One Float where- toRow _ n = [BS.pack $ show n]+ toRow _ n = [Just $ BS.pack $ show n] instance (NTimes (Vector n), Backend backend, ToRow backend n a) => ToRow backend n (Maybe a) where toRow backend = \case- Nothing -> ntimes "NULL"+ Nothing -> ntimes Nothing Just x -> toRow backend x instance ( NTimes (Vector k), NTimes (Vector l), Backend backend
src/Database/Seakale/Types.hs view
@@ -8,6 +8,7 @@ import Control.Monad.Writer import Data.List+import Data.Maybe import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL @@ -111,7 +112,7 @@ go :: Query n -> QueryData n -> [BS.ByteString] go req dat = case (req, dat) of (Plain bs req', _) -> bs : go req' dat- (Hole req', Cons bs dat') -> bs : go req' dat'+ (Hole req', Cons mBS dat') -> fromMaybe "NULL" mBS : go req' dat' (EmptyQuery, Nil) -> [] formatMany :: RepeatQuery k l i -> QueryData k -> QueryData i -> [QueryData l]@@ -144,7 +145,7 @@ deriving instance Show (ColumnType backend) => Show (ColumnInfo backend) deriving instance Eq (ColumnType backend) => Eq (ColumnInfo backend) -type QueryData n = Vector n BS.ByteString+type QueryData n = Vector n (Maybe BS.ByteString) data Vector :: Nat -> * -> * where Cons :: a -> Vector n a -> Vector ('S n) a