packages feed

esqueleto-compat (empty) → 0.0.2.0

raw patch · 9 files changed

+419/−0 lines, 9 filesdep +basedep +conduitdep +esqueletosetup-changed

Dependencies added: base, conduit, esqueleto, esqueleto-compat, hspec, persistent, resourcet, transformers

Files

+ ChangeLog.md view
@@ -0,0 +1,12 @@+# Changelog for esqueleto-compat++## 0.0.2.0++- [#2](https://github.com/parsonsmatt/esqueleto-compat/pull/2)+    - Add `tabulateRecordA` to `Record` class. `tabulate` and `allFields` are now normal functions.+    - Provide a default implementation of `recordFieldLabel` for `Show`able fields.+    +## 0.0.1.1++* [#4](https://github.com/parsonsmatt/esqueleto-compat/pull/4)+    * Compatibility with `template-haskell-2.18` and above
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Matt Parsons, Mercury Technologies (c) 2023++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,32 @@+# esqueleto-compat++This library aims to provide compatibility operators that can allow esqueleto and persistent to be imported together.++Operators like `==.` and `>=.` are defined as class members, and you can use them in the same module.+Functions like `update` that are shared in both libraries are given an `E` suffix for the `esqueleto` version.+And functions for operating on `SqlExpr` are given an `_` suffix when the name would otherwise be a conflict.++## Example:++```haskell+import Database.Esqueleto.Compat++foo :: MonadIO m => TableId -> SqlPersistT m ()+foo tableKey = do+    -- Esqueleto:+    updateE $ \table -> do+        set [table ^. TableField =. val "Hello"] table+        where_ $ table ^. TableId ==. val tableKey++    -- Persistent+    update tableKey [TableField =. "Goodbye"]++    -- Esqueleto:+    select $ do+        pure $ exists_ $ do+            t <- from $ table @Table+            where_ $ t ^. TableField ==. val "Hello"++    -- Persistent+    exists [TableField ==. val "Hello"]+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ esqueleto-compat.cabal view
@@ -0,0 +1,82 @@+cabal-version: 1.12++name:           esqueleto-compat+version:        0.0.2.0+description:    Please see the README on GitHub at <https://github.com/parsonsmatt/esqueleto-compat#readme>+homepage:       https://github.com/parsonsmatt/esqueleto-compat#readme+bug-reports:    https://github.com/parsonsmatt/esqueleto-compat/issues+author:         Matt von Hagen+maintainer:     parsonsmatt@gmail.com+copyright:      2023 Matt von Hagen+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md+synopsis: Compatibility operators for Persistent and Esqueleto+category: Data++source-repository head+  type: git+  location: https://github.com/parsonsmatt/esqueleto-compat++library+  exposed-modules:+    Database.Esqueleto.Compat+    Database.Esqueleto.Compat.Operators+    Database.Esqueleto.Compat.Suffixed++  build-depends:+      base              >= 4.13 && < 5+    , persistent+    , esqueleto+    , transformers+    , resourcet+    , conduit++  hs-source-dirs:+      src+  default-language: Haskell2010++  default-extensions:+    AllowAmbiguousTypes+    BlockArguments+    DataKinds+    DefaultSignatures+    DeriveGeneric+    DerivingStrategies+    ExplicitForAll+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    KindSignatures+    MultiParamTypeClasses+    NamedFieldPuns+    NoStarIsType+    OverloadedStrings+    QuantifiedConstraints+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    TemplateHaskell+    TypeApplications+    TypeFamilies+    TypeOperators+    StandaloneDeriving+    UndecidableInstances+    ConstraintKinds+    ViewPatterns++test-suite esqueleto-compat-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , esqueleto-compat+    , hspec+  default-language: Haskell2010
+ src/Database/Esqueleto/Compat.hs view
@@ -0,0 +1,38 @@+-- | This package aims to provide compatibility operators for @esqueleto@+-- and @persistent@ such that you can import "Database.Esqueleto.Compat"+-- without name conflicts.+--+-- This module re-exports "Database.Persist.Sql" and+-- "Database.Esqueleto.Experimental" together and hides the conflicting+-- terms in each module. Then we expose compatibility operators (like+-- '==.') that can work in either context, and names with suffixes to avoid+-- conflicts for other things (like 'updateE' instead of+-- 'Database.Esqueleto.Experimental.update').+module Database.Esqueleto.Compat+    ( -- * The compatibility operators+      module Database.Esqueleto.Compat.Operators+    , -- * Re-exports from "Database.Esqueleto.Experimental"+        module Database.Esqueleto.Experimental+      -- * Re-exports from "Database.Persist.Sql"+    , module Database.Persist.Sql+    ) where++import Database.Esqueleto.Experimental hiding+    ( not_+    , update+    , selectSource+    , exists+    , delete+    , count+    , (-=.)+    , (*=.)+    , (+=.)+    , (&&.), (=.), (<.), (>=.), (||.), (/=.), (<=.), (>.), (!=.), (==.))+import Database.Esqueleto.Compat.Operators+import Database.Esqueleto.Compat.Suffixed+import Database.Persist.Sql hiding+    ( (-=.)+    , (*=.)+    , (+=.)+    , (/=.)+    , (<=.), (<.), (>=.), (=.), (||.), (>.), (/=.), (!=.), (==.))
+ src/Database/Esqueleto/Compat/Operators.hs view
@@ -0,0 +1,151 @@+module Database.Esqueleto.Compat.Operators where++import Database.Esqueleto.Experimental (SqlExpr, Value)+import qualified Database.Esqueleto.Experimental as Esqueleto+import qualified Database.Esqueleto.Internal.Internal as Esqueleto+import Database.Persist.Sql (Entity, EntityField, PersistEntity, PersistField, Filter)+import qualified Database.Persist.Sql as Persist+import GHC.TypeLits+import Data.Kind++-- | A class for assigning a value in SQL, shared among the @persistent@ and+-- @esqueleto@ libraries.+class SqlAssignment a b c where+  (=.) :: a -> b -> c+  (-=.) :: a -> b -> c+  (+=.) :: a -> b -> c+  (*=.) :: a -> b -> c++infixr 3 =.++instance+  ( PersistField typ+  , field ~ EntityField rec typ'+  , typ ~ typ'+  ) =>+  SqlAssignment field typ (Persist.Update rec)+  where+  (=.) = (Persist.=.)+  (-=.) = (Persist.-=.)+  (+=.) = (Persist.+=.)+  (*=.) = (Persist.*=.)++instance+  (PersistEntity rec, PersistField typ, field ~ EntityField rec typ) =>+  SqlAssignment field (SqlExpr (Value typ)) (SqlExpr (Entity rec) -> SqlExpr Esqueleto.Update)+  where+  (=.) = (Esqueleto.=.)+  (-=.) = (Esqueleto.-=.)+  (+=.) = (Esqueleto.+=.)+  (*=.) = (Esqueleto.*=.)++-- Esqueleto: (||.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)+-- Persistent: (||.) :: [Filter v] -> [Filter v] -> [Filter v]++-- | A class for abstracting over 'Bool'-like operations.+--+-- Irritatingly, we can't have 'not_' in here, because @persistent@ actually+-- doesn't have such a function! That's why the 'SqlBooleanNot' class exists.+class SqlBoolean a where+  true_ :: a+  false_ :: a+  (||.) :: a -> a -> a+  (&&.) :: a -> a -> a++infixr 3 &&.++infixr 2 ||.++class SqlBoolean a => SqlBooleanNot a where+  not_ :: a -> a++-- | 'SqlExpr' can be compared as 'SqlBoolean' values, provided that they+-- contain a @'Value' 'Bool'@.+--+-- The implementation uses the @(a ~ Bool)@ equality constraint so that+-- polymorphic definitions don't get too confused.+instance (a ~ Bool) => SqlBoolean (SqlExpr (Value a)) where+  true_ = Esqueleto.val True+  false_ = Esqueleto.val False+  (||.) = (Esqueleto.||.)+  (&&.) = (Esqueleto.&&.)++instance (a ~ Bool) => SqlBooleanNot (SqlExpr (Value a)) where+  not_ = Esqueleto.not_++-- | This is a bit of a weird definition.+--+-- Turns out, 'Persistent.||.' is very rarely used in the codebase - we actually+-- have more uses of 'Persist.FilterOr'! And there *isn't* a '&&.' in+-- @persistent@ at all.+instance SqlBoolean [Persist.Filter k] where+  true_ = []+  false_ = [Persist.FilterOr []]+  (||.) = (Persist.||.)+  (&&.) = (<>)++-- | A 'TypeError' instance is provided so that folks don't get too confused,+-- though I doubt they'll run into this.+instance+  ( TypeError+      ( 'Text "`persistent` does not have a `not_` operator for filters. Instead, use the "+          ':$$: 'Text "inverse operator, like `<.` instead of `>=.`."+      )+  ) =>+  SqlBooleanNot [Persist.Filter t]+  where+  not_ = error "unreachable"++-- | A class for comparing for equality in @persistent@ and @esqueleto@. The+-- first two type parameters are the inputs to the binary operator, and the+-- final one is the result type.+class SqlComparison a b c | c a -> b, c b -> a, a b -> c where+  (==.) :: a -> b -> c+  (!=.) :: a -> b -> c+  (>.) :: a -> b -> c+  (>=.) :: a -> b -> c+  (<.) :: a -> b -> c+  (<=.) :: a -> b -> c++infix 4 ==., !=., /=., >=., >., <=., <.++type family NotSqlExprEq rec typ' typ :: Constraint where+  NotSqlExprEq rec typ' (SqlExpr (Value _)) =+    TypeError (NotSqlExprEqMessage rec typ')+  NotSqlExprEq _ _ _ =+    ()++type NotSqlExprEqMessage rec typ =+  'Text "You used a bare `"+    ':<>: 'ShowType (EntityField rec typ)+    ':<>: 'Text "` field."+    ':$$: 'Text "If you're writing a Persistent expression, you don't need to use `val`."+    ':$$: 'Text "If you're writing an esqueleto expression, you need to project from a "+    ':$$: 'Text "table variable, like: e ^. FooName"++instance+  (lhs ~ EntityField rec typ, PersistField typ, typ ~ typ', NotSqlExprEq rec typ typ', rec ~ rec') =>+  SqlComparison (EntityField rec typ) typ' (Filter rec')+  where+  (==.) = (Persist.==.)+  (!=.) = (Persist.!=.)+  (>.) = (Persist.>.)+  (>=.) = (Persist.>=.)+  (<.) = (Persist.<.)+  (<=.) = (Persist.<=.)++instance+  (PersistField a, a ~ b, lhs ~ SqlExpr (Value a), c ~ Bool) =>+  SqlComparison (SqlExpr (Value a)) (SqlExpr (Value b)) (SqlExpr (Value c))+  where+  (==.) = (Esqueleto.==.)+  (!=.) = (Esqueleto.!=.)+  (>.) = (Esqueleto.>.)+  (>=.) = (Esqueleto.>=.)+  (<.) = (Esqueleto.<.)+  (<=.) = (Esqueleto.<=.)++-- | An alias for '!=.', in keeping with the convention of having Haskell-ish+-- operators.+(/=.) :: SqlComparison a b c => a -> b -> c+(/=.) = (!=.)
+ src/Database/Esqueleto/Compat/Suffixed.hs view
@@ -0,0 +1,67 @@+-- | This module defines new names for terms in @esqueleto@ that have+-- common conflicts with other modules.+--+-- Functions that perform "actions" are generally suffixed with an @E@. So+-- @update@ becomes @updateE@.+--+-- Functions that are about manipulating 'SqlExpr' are suffixed with an+-- @_@. So @isNothing@ becomes 'isNothing_'.+module Database.Esqueleto.Compat.Suffixed where++import qualified Database.Esqueleto.Experimental as E+import Database.Esqueleto.Internal.Internal+import Database.Esqueleto.Experimental+    ( SqlExpr+    , Entity, SqlQuery, PersistEntity, BackendCompatible, SqlBackend+    , PersistEntityBackend+    , PersistQueryWrite+    , PersistUniqueWrite+    )+import Control.Monad.Trans.Reader+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import Conduit++updateE+    :: ( MonadIO m+        , PersistEntity record+        , BackendCompatible SqlBackend backend+        , BackendCompatible SqlBackend (PersistEntityBackend record)+        , PersistQueryWrite backend+        , PersistUniqueWrite backend+        )+    => (SqlExpr (Entity record) -> SqlQuery ()) -> ReaderT backend m ()+updateE = E.update++selectSourceE+    :: (SqlSelect a r+        , BackendCompatible SqlBackend backend+        , E.IsPersistBackend backend+        , E.PersistQueryRead backend+        , E.PersistUniqueRead backend+        , MonadResource m+        )+    => SqlQuery a+    -> ConduitT () r (ReaderT backend m) ()+selectSourceE =+    E.selectSource++exists_ :: SqlQuery () -> SqlExpr (Value Bool)+exists_ = E.exists++deleteE+    :: (MonadIO m+        , BackendCompatible SqlBackend backend, PersistQueryWrite backend, PersistUniqueWrite backend+        )+    => SqlQuery ()+    -> ReaderT backend m ()+deleteE = E.delete++count_ :: (Num a) => SqlExpr (Value typ) -> SqlExpr (Value a)+count_ = E.count++groupBy_ :: (ToSomeValues a) => a -> SqlQuery ()+groupBy_ = E.groupBy++isNothing_ :: (E.PersistField a) => SqlExpr (Value (Maybe a)) -> SqlExpr (Value Bool)+isNothing_ = E.isNothing
+ test/Spec.hs view
@@ -0,0 +1,5 @@+{-# options_ghc -Wall #-}+module Main where++main :: IO ()+main = putStrLn "no tests yet boss"