diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4e5c416 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +/dist* +*~ diff --git a/esqueleto.cabal b/esqueleto.cabal index 0423e2d..f4b22ed 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,21 +1,28 @@ --- Initial esqueleto.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: esqueleto version: 0.1 synopsis: Type-safe EDSL for SQL queries on persistent backends. --- description: +-- description: homepage: https://github.com/meteficha/esqueleto license: BSD3 license-file: LICENSE author: Felipe Lessa maintainer: felipe.lessa@gmail.com --- copyright: +-- copyright: category: Database build-type: Simple cabal-version: >=1.8 library - -- exposed-modules: - -- other-modules: - build-depends: base ==4.5.* \ No newline at end of file + exposed-modules: + Database.Esqueleto + Database.Esqueleto.Internal.Types + Database.Esqueleto.Internal.Language + -- other-modules: + build-depends: + base == 4.5.* + , text == 0.11.* + , persistent == 1.0.* + , transformers == 0.3.* + , monad-supply == 0.3.* + hs-source-dirs: src/ + ghc-options: -Wall diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs new file mode 100644 index 0000000..21bd521 --- /dev/null +++ b/src/Database/Esqueleto.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs #-} + +module Database.Esqueleto + ( -- * Queries + Query + , select + , from + , where_ + + -- * Expressions + , Expr + , Value + , (^.) + , val + , sub + + -- ** Comparison operators + , (==.) + , (>=.) + , (>.) + , (<=.) + , (<.) + , (!=.) + + -- ** Boolean operators + , not_ + , (&&.) + , (||.) + + -- ** Numerical operators + , (+.) + , (-.) + , (*.) + , (/.) + ) where + +import Database.Esqueleto.Internal.Types +import Database.Esqueleto.Internal.Language diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs new file mode 100644 index 0000000..b9042bc --- /dev/null +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs #-} +module Database.Esqueleto.Internal.Language + ( -- * Constructing queries + select + , from + , where_ + + -- * Expressions + , (^.) + , val + , sub + + -- ** Comparison operators + , (==.) + , (>=.) + , (>.) + , (<=.) + , (<.) + , (!=.) + + -- ** Boolean operators + , not_ + , (&&.) + , (||.) + + -- ** Numerical operators + , (+.) + , (-.) + , (*.) + , (/.) + ) where + +import Control.Applicative (Applicative(..), (<$>)) +import Database.Persist.GenericSql +import Database.Persist.Store +import Database.Persist.Query (PersistQuery) +import qualified Control.Monad.Supply as S + +import Database.Esqueleto.Internal.Types + + +-- | TODO +select :: PersistQuery SqlPersist m => Query a -> SqlPersist m a +select = undefined + + +class From a where + -- | @FROM@ clause: bring an entity into scope. + -- + -- The following types implement 'from': + -- + -- * @Expr (Entity val)@, which brings a single entity into scope. + -- + -- * Tuples of any other types supported by 'from'. Calling + -- 'from' multiple times is the same as calling 'from' a + -- single time and using a tuple. + -- + -- Note that using 'from' for the same entity twice does work + -- and corresponds to a self-join. You don't even need to use + -- two different calls to 'from', you may use a tuple. + from :: Query a + +instance (PersistEntity val, PersistEntityBackend val ~ SqlPersist) => From (Expr (Entity val)) where + from = Q $ ETable <$> S.supply +instance (From a, From b) => From (a, b) where + from = (,) <$> from <*> from +instance (From a, From b, From c) => From (a, b, c) where + from = (,,) <$> from <*> from <*> from +instance (From a, From b, From c, From d) => From (a, b, c, d) where + from = (,,,) <$> from <*> from <*> from <*> from +instance (From a, From b, From c, From d, From e) => From (a, b, c, d, e) where + from = (,,,,) <$> from <*> from <*> from <*> from <*> from +instance (From a, From b, From c, From d, From e, From f) => From (a, b, c, d, e, f) where + from = (,,,,,) <$> from <*> from <*> from <*> from <*> from <*> from +instance (From a, From b, From c, From d, From e, From f, From g) => From (a, b, c, d, e, f, g) where + from = (,,,,,,) <$> from <*> from <*> from <*> from <*> from <*> from <*> from +instance (From a, From b, From c, From d, From e, From f, From g, From h) => From (a, b, c, d, e, f, g, h) where + from = (,,,,,,,) <$> from <*> from <*> from <*> from <*> from <*> from <*> from <*> from + + +-- | @WHERE@ clause: restrict the query's result. +where_ :: Value Bool -> Query () +where_ = undefined + + +-- | Execute a subquery in an expression. +sub :: Query (Expr a) -> Expr a +sub = ESub + + +-- | Project a field of an entity. +(^.) :: PersistField typ => Expr (Entity val) -> EntityField val typ -> Value typ +(^.) = EProj + + +-- | Lift a constant value from Haskell-land to the query. +val :: PersistField typ => typ -> Value typ +val = EVal + + +(==.), (>=.), (>.), (<=.), (<.), (!=.) :: PersistField typ => Value typ -> Value typ -> Value Bool +(==.) = EBinOp OEq +(>=.) = EBinOp OGeq +(>.) = EBinOp OGt +(<=.) = EBinOp OLeq +(<.) = EBinOp OLt +(!=.) = EBinOp ONeq + +not_ :: Value Bool -> Value Bool +not_ = ENot + +(&&.), (||.) :: Value Bool -> Value Bool -> Value Bool +(&&.) = EBinOp OAnd +(||.) = EBinOp OOr + +(+.), (-.), (/.), (*.) :: (Num a, PersistField a) => Value a -> Value a -> Value a +(+.) = EBinOp OAdd +(-.) = EBinOp OSub +(/.) = EBinOp ODiv +(*.) = EBinOp OMult + + +-- Fixity declarations +infixl 9 ^. +infixl 7 *., /. +infixl 6 +., -. +infix 4 ==., >=., >., <=., <., !=. +infixr 3 &&. +infixr 2 ||. diff --git a/src/Database/Esqueleto/Internal/Types.hs b/src/Database/Esqueleto/Internal/Types.hs new file mode 100644 index 0000000..fbc81c9 --- /dev/null +++ b/src/Database/Esqueleto/Internal/Types.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs #-} +module Database.Esqueleto.Internal.Types + ( Query(..) + , Ident(..) + , Expr(..) + , BinOp(..) + , Value + ) where + +import Control.Applicative (Applicative(..)) +import Control.Monad (ap) +import Data.Text (Text) +import Database.Persist.GenericSql +import Database.Persist.Store +import qualified Control.Monad.Supply as S + + +-- | TODO +newtype Query a = + Q { unQ :: S.Supply Ident a } + +instance Functor Query where + fmap f = Q . fmap f . unQ + +instance Monad Query where + return = Q . return + m >>= f = Q (unQ m >>= unQ . f) + +instance Applicative Query where + pure = return + (<*>) = ap + + +-- | Identifier used for tables. +newtype Ident = Ident Text + + +-- | TODO +data Expr a where + ETable :: (PersistEntity val, PersistEntityBackend val ~ SqlPersist) => Ident -> Expr (Entity val) + ESub :: Query (Expr a) -> Expr a + EProj :: PersistField typ => Expr (Entity val) -> EntityField val typ -> Expr (Single typ) + EVal :: PersistField typ => typ -> Expr (Single typ) + EBinOp :: BinOp a b r -> Expr (Single a) -> Expr (Single b) -> Expr (Single r) + ENot :: Expr (Single Bool) -> Expr (Single Bool) + + +-- | A binary operation. +data BinOp a b r where + OEq :: PersistField typ => BinOp typ typ Bool + OGeq :: PersistField typ => BinOp typ typ Bool + OGt :: PersistField typ => BinOp typ typ Bool + OLeq :: PersistField typ => BinOp typ typ Bool + OLt :: PersistField typ => BinOp typ typ Bool + ONeq :: PersistField typ => BinOp typ typ Bool + + OAnd :: BinOp Bool Bool Bool + OOr :: BinOp Bool Bool Bool + + OAdd :: (Num a, PersistField a) => BinOp a a a + OSub :: (Num a, PersistField a) => BinOp a a a + ODiv :: (Num a, PersistField a) => BinOp a a a + OMult :: (Num a, PersistField a) => BinOp a a a + + +-- | A 'Value' is just a type synonym for expressions whose types +-- are not entities but simple values. +type Value a = Expr (Single a)