esqueleto 0.2.8 → 0.2.9

raw patch · 5 files changed

+156/−11 lines, 5 filesdep ~fast-loggerPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: fast-logger

API changes (from Hackage documentation)

Files

• esqueleto.cabal +2/−2
• src/Database/Esqueleto.hs +3/−0
• src/Database/Esqueleto/Internal/Language.hs +43/−2
• src/Database/Esqueleto/Internal/Sql.hs +30/−6
• test/Test.hs +78/−1

@@ -1,5 +1,5 @@ name:                esqueleto-version:             0.2.8+version:             0.2.9 synopsis:            Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage:            https://github.com/meteficha/esqueleto license:             BSD3@@ -85,7 +85,7 @@     , persistent-template == 1.0.*     , monad-control     , monad-logger-    , fast-logger         == 0.2.*+    , fast-logger         >= 0.2 && < 0.4     , transformers-base     , template-haskell 

@@ -24,9 +24,12 @@              , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)              , (+.), (-.), (/.), (*.)              , like, (%), concat_, (++.)+             , subList_select, subList_selectDistinct, valList+             , in_, notIn, exists, notExists              , set, (=.), (+=.), (-=.), (*=.), (/=.) )   , from   , Value(..)+  , ValueList(..)   , OrderBy     -- ** Joins   , InnerJoin(..)

@@ -16,6 +16,7 @@     Esqueleto(..)   , from   , Value(..)+  , ValueList(..)   , SomeValue(..)   , ToSomeValues(..)   , InnerJoin(..)@@ -173,10 +174,12 @@   -- | @OFFSET@.  Usually used with 'limit'.   offset :: Int64 -> query () -  -- | Execute a subquery @SELECT@ in an expression.+  -- | Execute a subquery @SELECT@ in an expression.  Returns a+  -- simple value so should be used only when the @SELECT@ query+  -- is guaranteed to return just one row.   sub_select :: PersistField a => query (expr (Value a)) -> expr (Value a) -  -- | Execute a subquery @SELECT DISTINCT@ in an expression.+  -- | Same as 'sub_select' but using @SELECT DISTINCT@.   sub_selectDistinct :: PersistField a => query (expr (Value a)) -> expr (Value a)    -- | Project a field of an entity.@@ -240,6 +243,37 @@   -- Supported by SQLite and PostgreSQL.   (++.) :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value s) +  -- | Execute a subquery @SELECT@ in an expression.  Returns a+  -- list of values.+  subList_select :: PersistField a => query (expr (Value a)) -> expr (ValueList a)++  -- | Same as 'sublist_select' but using @SELECT DISTINCT@.+  subList_selectDistinct :: PersistField a => query (expr (Value a)) -> expr (ValueList a)++  -- | Lift a list of constant value from Haskell-land to the query.+  valList :: PersistField typ => [typ] -> expr (ValueList typ)++  -- | @IN@ operator.+  in_ :: PersistField typ => expr (Value typ) -> expr (ValueList typ) -> expr (Value Bool)++  -- | @NOT IN@ operator.+  notIn :: PersistField typ => expr (Value typ) -> expr (ValueList typ) -> expr (Value Bool)++  -- | @EXISTS@ operator.  For example:+  --+  -- @+  -- select $+  -- from $ \person -> do+  -- where_ $ exists $+  --          from $ \post -> do+  --          where_ (post ^. BlogPostAuthorId ==. person ^. PersonId)+  -- return person+  -- @+  exists :: query () -> expr (Value Bool)++  -- | @NOT EXISTS@ operator.+  notExists :: query () -> expr (Value Bool)+   -- | @SET@ clause used on @UPDATE@s.  Note that while it's not   -- a type error to use this function on a @SELECT@, it will   -- most certainly result in a runtime error.@@ -265,6 +299,13 @@ -- | A single value (as opposed to a whole entity).  You may use -- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'. data Value a = Value a deriving (Eq, Ord, Show, Typeable)+-- Note: because of GHC bug #6124 we use @data@ instead of @newtype@.+++-- | A list of single values.  There's a limited set of funcitons+-- able to work with this data type (such as 'subList_select',+-- 'valList', 'in_' and 'exists').+data ValueList a = ValueList a deriving (Eq, Ord, Show, Typeable) -- Note: because of GHC bug #6124 we use @data@ instead of @newtype@.  

@@ -35,7 +35,7 @@   , veryUnsafeCoerceSqlExprValue   ) where -import Control.Applicative (Applicative(..), (<$>))+import Control.Applicative (Applicative(..), (<$>), (<$)) import Control.Arrow ((***), first) import Control.Exception (throw, throwIO) import Control.Monad ((>=>), ap, MonadPlus(..))@@ -228,6 +228,7 @@   EEntity  :: Ident -> SqlExpr (Entity val)   EMaybe   :: SqlExpr a -> SqlExpr (Maybe a)   ERaw     :: NeedParens -> (Connection -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)+  EList    :: SqlExpr (Value a) -> SqlExpr (ValueList a)   EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy   ESet     :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val)   EPreprocessedFrom :: a -> FromClause -> SqlExpr (PreprocessedFrom a)@@ -324,6 +325,18 @@   concat_ = unsafeSqlFunction "CONCAT"   (++.)   = unsafeSqlBinOp    " || " +  subList_select         = EList . sub_select+  subList_selectDistinct = EList . sub_selectDistinct++  valList vals = EList $ ERaw Parens $ const ( uncommas ("?" <$ vals)+                                             , map toPersistValue vals )++  v `in_`   e = unsafeSqlBinOp     " IN " v (veryUnsafeCoerceSqlExprValueList e)+  v `notIn` e = unsafeSqlBinOp " NOT IN " v (veryUnsafeCoerceSqlExprValueList e)++  exists    = unsafeSqlFunction     "EXISTS " . existsHelper+  notExists = unsafeSqlFunction "NOT EXISTS " . existsHelper+   set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds }     where       apply (ESet f) = SetClause (f ent)@@ -338,7 +351,6 @@ instance ToSomeValues SqlExpr (SqlExpr (Value a)) where   toSomeValues a = [SomeValue a] - fieldName :: (PersistEntity val, PersistField typ)           => Connection -> EntityField val typ -> TLB.Builder fieldName conn = fromDBName conn . fieldDB . persistFieldDef@@ -351,12 +363,18 @@   where name = ERaw Never $ \conn -> (fieldName conn field, mempty)  sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)-sub mode query = ERaw Parens $ \conn -> first parens (toRawSql mode conn query)+sub mode query = ERaw Parens $ \conn -> toRawSql mode conn query  fromDBName :: Connection -> DBName -> TLB.Builder fromDBName conn = TLB.fromText . escapeName conn +existsHelper :: SqlQuery () -> SqlExpr (Value a)+existsHelper =+  ERaw Parens .+  flip (toRawSql SELECT) .+  (>> return (val True :: SqlExpr (Value Bool))) + ----------------------------------------------------------------------  @@ -423,11 +441,17 @@   toArgList = toArgList . from4  --- | (Internal) Coerce a type of a 'SqlExpr (Value a)' into--- another 'SqlExpr (Value b)'.  You should /not/ use this--- function unless you know what you're doing!+-- | (Internal) Coerce a value's type from 'SqlExpr (Value a)' to+-- 'SqlExpr (Value b)'.  You should /not/ use this function+-- unless you know what you're doing! veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b) veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f+++-- | (Internal) Coerce a value's type from 'SqlExpr (ValueList+-- a)' to 'SqlExpr (Value a)'.+veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a)+veryUnsafeCoerceSqlExprValueList (EList v) = v   ----------------------------------------------------------------------

@@ -463,7 +463,84 @@                                   , Entity p3k p3 { personAge = Just 7 }                                   , Entity p2k p2 { personAge = Just 0 } ] +    describe "lists of values" $ do+      it "IN works for valList" $+        run $ do+          p1k <- insert p1+          p2k <- insert p2+          p3k <- insert p3+          ret <- select $+                 from $ \p -> do+                 where_ (p ^. PersonName `in_` valList (personName <$> [p1, p2]))+                 return p+          liftIO $ ret `shouldBe` [ Entity p1k p1+                                  , Entity p2k p2 ] +      it "IN works for subList_select" $+        run $ do+          p1k <- insert p1+          p2k <- insert p2+          p3k <- insert p3+          _ <- insert (BlogPost "" p1k)+          _ <- insert (BlogPost "" p3k)+          ret <- select $+                 from $ \p -> do+                 let subquery =+                       from $ \bp ->+                       return (bp ^. BlogPostAuthorId)+                 where_ (p ^. PersonId `in_` subList_select subquery)+                 return p+          liftIO $ ret `shouldBe` [ Entity p1k p1+                                  , Entity p3k p3 ]++      it "NOT IN works for subList_select" $+        run $ do+          p1k <- insert p1+          p2k <- insert p2+          p3k <- insert p3+          _ <- insert (BlogPost "" p1k)+          _ <- insert (BlogPost "" p3k)+          ret <- select $+                 from $ \p -> do+                 let subquery =+                       from $ \bp ->+                       return (bp ^. BlogPostAuthorId)+                 where_ (p ^. PersonId `notIn` subList_select subquery)+                 return p+          liftIO $ ret `shouldBe` [ Entity p2k p2 ]++      it "EXISTS works for subList_select" $+        run $ do+          p1k <- insert p1+          p2k <- insert p2+          p3k <- insert p3+          _ <- insert (BlogPost "" p1k)+          _ <- insert (BlogPost "" p3k)+          ret <- select $+                 from $ \p -> do+                 where_ $ exists $+                          from $ \bp -> do+                          where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId)+                 return p+          liftIO $ ret `shouldBe` [ Entity p1k p1+                                  , Entity p3k p3 ]++      it "EXISTS works for subList_select" $+        run $ do+          p1k <- insert p1+          p2k <- insert p2+          p3k <- insert p3+          _ <- insert (BlogPost "" p1k)+          _ <- insert (BlogPost "" p3k)+          ret <- select $+                 from $ \p -> do+                 where_ $ notExists $+                          from $ \bp -> do+                          where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId)+                 return p+          liftIO $ ret `shouldBe` [ Entity p2k p2 ]++ ----------------------------------------------------------------------  @@ -486,7 +563,7 @@   verbose :: Bool-verbose = False+verbose = True   run_worker :: RunDbMonad m => SqlPersist (C.ResourceT m) a -> m a