Initial skeleton.

.gitignore

@@ -0,0 +1,2 @@
+/dist*
+*~

esqueleto.cabal

@@ -1,6 +1,3 @@
--- 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.
@@ -16,6 +13,16 @@ build-type:          Simple
 cabal-version:       >=1.8
 
 library
-  -- exposed-modules:     
+  exposed-modules:
+    Database.Esqueleto
+    Database.Esqueleto.Internal.Types
+    Database.Esqueleto.Internal.Language
   -- other-modules:
-  build-depends:       base ==4.5.*
+  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

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

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 ||.

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)