esqueleto 2.1.1 → 2.1.2

raw patch · 5 files changed

+140/−2 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• esqueleto.cabal +1/−1
• src/Database/Esqueleto.hs +5/−1
• src/Database/Esqueleto/Internal/Language.hs +62/−0
• src/Database/Esqueleto/Internal/Sql.hs +25/−0
• test/Test.hs +47/−0

@@ -1,5 +1,5 @@ name:                esqueleto-version:             2.1.1+version:             2.1.2 synopsis:            Type-safe EDSL for SQL queries on persistent backends. homepage:            https://github.com/prowdsponsor/esqueleto license:             BSD3

@@ -49,7 +49,11 @@              , like, (%), concat_, (++.)              , subList_select, subList_selectDistinct, valList              , in_, notIn, exists, notExists-             , set, (=.), (+=.), (-=.), (*=.), (/=.) )+             , set, (=.), (+=.), (-=.), (*=.), (/=.)+             , case_ )+  , when_+  , then_+  , else_   , from   , Value(..)   , unValue

@@ -35,6 +35,9 @@   , PreprocessedFrom   , From   , FromPreprocess+  , when_+  , then_+  , else_   ) where  import Control.Applicative (Applicative(..), (<$>))@@ -336,6 +339,48 @@   -- | Apply extra @expr Value@ arguments to a 'PersistField' constructor   (<&>) :: expr (Insertion (a -> b)) -> expr (Value a) -> expr (Insertion b) +  -- | @CASE@ statement.  For example:+  --+  -- @+  -- select $+  -- return $+  -- case_+  --    [ when_+  --        (exists $+  --        from $ \\p -> do+  --        where_ (p ^. PersonName ==. val "Mike"))+  --      then_+  --        (sub_select $+  --        from $ \\v -> do+  --        let sub =+  --                from $ \\c -> do+  --                where_ (c ^. PersonName ==. val "Mike")+  --                return (c ^. PersonFavNum)+  --        where_ (v ^. PersonFavNum >. sub_select sub)+  --        return $ count (v ^. PersonName) +. val (1 :: Int)) ]+  --    (else_ $ val (-1))+  -- @+  --+  -- This query is a bit complicated, but basically it checks if a person+  -- named "Mike" exists, and if that person does, run the subquery to find+  -- out how many people have a ranking (by Fav Num) higher than "Mike".+  --+  -- __NOTE:__ There are a few things to be aware about this statement.+  --+  --    * This only implements the full CASE statement, it does not+  --      implement the "simple" CASE statement.+  --+  --+  --    * At least one 'when_' and 'then_' is mandatory otherwise it will+  --      emit an error.+  --+  --+  --    * The 'else_' is also mandatory, unlike the SQL statement in which+  --      if the @ELSE@ is omitted it will return a @NULL@. You can+  --      reproduce this via 'nothing'.+  --+  -- /Since: 2.1.2/+  case_ :: PersistField a => [(expr (Value Bool), expr (Value a))] -> expr (Value a) -> expr (Value a)  -- Fixity declarations infixl 9 ^.@@ -346,6 +391,23 @@ infixr 3 &&., =., +=., -=., *=., /=. infixr 2 ||., `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin`, `like` +-- | Syntax sugar for 'case_'.+--+-- /Since: 2.1.2/+when_ :: expr (Value Bool) -> () -> expr a -> (expr (Value Bool), expr a)+when_ cond _ expr = (cond, expr)++-- | Syntax sugar for 'case_'.+--+-- /Since: 2.1.2/+then_ :: ()+then_ = ()++-- | Syntax sugar for 'case_'.+--+-- /Since: 2.1.2/+else_ :: expr a -> expr a+else_ = id  -- | A single value (as opposed to a whole entity).  You may use -- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'.

@@ -27,6 +27,7 @@   , insertSelectDistinct   , insertSelect     -- * The guts+  , unsafeSqlCase   , unsafeSqlBinOp   , unsafeSqlValue   , unsafeSqlFunction@@ -413,6 +414,7 @@         (gb, gv) = g x     in (fb <> ", " <> gb, fv ++ gv) +  case_ = unsafeSqlCase  instance ToSomeValues SqlExpr (SqlExpr (Value a)) where   toSomeValues a = [SomeValue a]@@ -446,6 +448,29 @@   ----------------------------------------------------------------------+++-- | (Internal) Create a case statement.+--+-- Since: 2.1.1+unsafeSqlCase :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a)+unsafeSqlCase when_ (ERaw p1 f1) = ERaw Never buildCase+  where+    buildCase :: IdentInfo -> (TLB.Builder, [PersistValue])+    buildCase info =+        let (b1, vals1) = f1 info+            (b2, vals2) = mapWhen when_ info+        in ( "CASE" <> b2 <> " ELSE " <> parensM p1 b1 <> " END", vals2 <> vals1)++    mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))] -> IdentInfo -> (TLB.Builder, [PersistValue])+    mapWhen []    _    = error "unsafeSqlCase: empty when_ list."+    mapWhen when_ info = foldl (foldHelp info) (mempty, mempty) when_++    foldHelp :: IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Value Bool), SqlExpr (Value a)) -> (TLB.Builder, [PersistValue])+    foldHelp info (b0, vals0) (ERaw p1 f1, ERaw p2 f2) =+        let (b1, vals1) = f1 info+            (b2, vals2) = f2 info+        in ( b0 <> " WHEN " <> parensM p1 b1 <> " THEN " <> parensM p2 b2, vals0 <> vals1 <> vals2 )   -- | (Internal) Create a custom binary operator.  You /should/

@@ -863,6 +863,53 @@            liftIO $ (ret1 == ret2) `shouldBe` False +    describe "case" $ do+      it "Works for a simple value based when - False" $+        run $ do+          ret <- select $+            return $+              case_+                [ when_ (val False) then_ (val (1 :: Int)) ]+                (else_ (val 2))++          liftIO $ ret `shouldBe` [ Value 2 ]++      it "Works for a simple value based when - True" $+        run $ do+          ret <- select $+            return $+              case_+                [ when_ (val True) then_ (val (1 :: Int)) ]+                (else_ (val 2))++          liftIO $ ret `shouldBe` [ Value 1 ]++      it "works for a semi-complicated query" $+        run $ do+          _ <- insert p1+          _ <- insert p2+          _ <- insert p3+          _ <- insert p4+          _ <- insert p5+          ret <- select $+            return $+              case_+                [ when_+                    (exists $ from $ \p -> do+                        where_ (p ^. PersonName ==. val "Mike"))+                  then_+                    (sub_select $ from $ \v -> do+                        let sub =+                                from $ \c -> do+                                where_ (c ^. PersonName ==. val "Mike")+                                return (c ^. PersonFavNum)+                        where_ (v ^. PersonFavNum >. sub_select sub)+                        return $ count (v ^. PersonName) +. val (1 :: Int)) ]+                (else_ $ val (-1))++          liftIO $ ret `shouldBe` [ Value (3) ]++ ----------------------------------------------------------------------