-- | Module: Squeal.PostgreSQL
-- Description: Squeel export module
-- Copyright: (c) Eitan Chatav, 2017
-- Maintainer: eitan@morphism.tech
-- Stability: experimental
--
-- Squeal is a deep embedding of PostgreSQL in Haskell. Let's see an example!
--
-- First, we need some language extensions because Squeal uses modern GHC
-- features.
--
-- > {-# LANGUAGE
-- >     DataKinds
-- >   , DeriveGeneric
-- >   , OverloadedLabels
-- >   , OverloadedStrings
-- >   , TypeApplications
-- >   , TypeOperators
-- > #-}
--
-- Here comes the @Main@ module and imports.
--
-- > module Main (main) where
-- >
-- > import Control.Monad.Base (liftBase)
-- > import Data.Int (Int32)
-- > import Data.Text (Text)
-- >
-- > import Squeal.PostgreSQL
--
-- We'll use generics to easily convert between Haskell and PostgreSQL values.
--
-- > import qualified Generics.SOP as SOP
-- > import qualified GHC.Generics as GHC
--
-- The first step is to define the schema of our database. This is where
-- we use @DataKinds@ and @TypeOperators@. The schema consists of a type-level
-- list of tables, a `:::` pairing of a type level string or
-- @Symbol@ and a list a columns, itself a `:::` pairing of a
-- @Symbol@ and a `ColumnType`. The `ColumnType` describes the
-- PostgreSQL type of the column as well as whether or not it may contain
-- @NULL@ and whether or not inserts and updates can use a @DEFAULT@. For our
-- schema, we'll define two tables, a users table and an emails table.
--
-- > type Schema =
-- >   '[ "users"  :::
-- >        '[ "id"   ::: 'Optional ('NotNull 'PGint4)
-- >         , "name" ::: 'Required ('NotNull 'PGtext)
-- >         ]
-- >    , "emails" :::
-- >        '[ "id"      ::: 'Optional ('NotNull 'PGint4)
-- >         , "user_id" ::: 'Required ('NotNull 'PGint4)
-- >         , "email"   ::: 'Required ('Null 'PGtext)
-- >         ]
-- >    ]
--
-- Next, we'll write `Definition`s to set up and tear down the schema. In
-- Squeal, a `Definition` is a `createTable`, `alterTable` or `dropTable`
-- command and has two type parameters, corresponding to the schema
-- before being run and the schema after. We can compose definitions using
-- `>>>`. Here and in the rest of our commands we make use of overloaded
-- labels to refer to named tables and columns in our schema.
--
-- > setup :: Definition '[] Schema
-- > setup =
-- >   createTable #users
-- >     ( serial `As` #id :*
-- >       (text & notNull) `As` #name :* Nil )
-- >     [ primaryKey (Column #id :* Nil) ]
-- >   >>>
-- >   createTable #emails
-- >     ( serial `As` #id :*
-- >       (int & notNull) `As` #user_id :*
-- >       text `As` #email :* Nil )
-- >     [ primaryKey (Column #id :* Nil)
-- >     , foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)
-- >       OnDeleteCascade OnUpdateCascade ]
--
-- Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.
-- In our `createTable` commands we included `TableConstraint`s to define
-- primary and foreign keys, making them somewhat complex. Our tear down
-- `Definition` is simpler.
--
-- > teardown :: Definition Schema '[]
-- > teardown = dropTable #emails >>> dropTable #users
--
-- Next, we'll write `Manipulation`s to insert data into our two tables.
-- A `Manipulation` is a `insertInto`, `update` or `deleteFrom` command and
-- has three type parameters, the schema it refers to, a list of parameters
-- it can take as input, and a list of columns it produces as output. When
-- we insert into the users table, we will need a parameter for the @name@
-- field but not for the @id@ field. Since it's optional, we can use a default
-- value. However, since the emails table refers to the users table, we will
-- need to retrieve the user id that the insert generates and insert it into
-- the emails table. Take a careful look at the type and definition of both
-- of our inserts.
--
-- > insertUser :: Manipulation Schema
-- >   '[ 'Required ('NotNull 'PGtext)]
-- >   '[ "fromOnly" ::: 'Required ('NotNull 'PGint4) ]
-- > insertUser = insertInto #users
-- >   ( Values (def `As` #id :* param @1 `As` #name :* Nil) [] )
-- >   OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))
-- >
-- > insertEmail :: Manipulation Schema
-- >   '[ 'Required ('NotNull 'PGint4), 'Required ('Null 'PGtext)] '[]
-- > insertEmail = insertInto #emails ( Values
-- >   ( def `As` #id :*
-- >     param @1 `As` #user_id :*
-- >     param @2 `As` #email :* Nil) [] )
-- >   OnConflictDoNothing (Returning Nil)
--
-- Next we write a `Query` to retrieve users from the database. We're not
-- interested in the ids here, just the usernames and email addresses. We
-- need to use an inner join to get the right result. A `Query` is like a
-- `Manipulation` with the same kind of type parameters.
--
-- > getUsers :: Query Schema '[]
-- >   '[ "userName" ::: 'Required ('NotNull 'PGtext)
-- >    , "userEmail" ::: 'Required ('Null 'PGtext) ]
-- > getUsers = select
-- >   (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)
-- >   ( from (Table (#users `As` #u)
-- >     & InnerJoin (Table (#emails `As` #e))
-- >       (#u ! #id .== #e ! #user_id)) )
--
-- Now that we've defined the SQL side of things, we'll need a Haskell type
-- for users. We give the type `Generics.SOP.Generic` and
-- `Generics.SOP.HasDatatypeInfo` instances so that we can decode the rows
-- we receive when we run @getUsers@. Notice that the record fields of the
-- @User@ type match the column names of @getUsers@.
--
-- > data User = User { userName :: Text, userEmail :: Maybe Text }
-- >   deriving (Show, GHC.Generic)
-- > instance SOP.Generic User
-- > instance SOP.HasDatatypeInfo User
--
-- Let's also create some users to add to the database.
--
-- > users :: [User]
-- > users =
-- >   [ User "Alice" (Just "alice@gmail.com")
-- >   , User "Bob" Nothing
-- >   , User "Carole" (Just "carole@hotmail.com")
-- >   ]
--
-- Now we can put together all the pieces into a program. The program
-- connects to the database, sets up the schema, inserts the user data
-- (using prepared statements as an optimization), queries the user
-- data and prints it out and finally closes the connection. Since the
-- `Connection` tracks the schema of the database, we get a new one
-- when we execute our statements.
--
-- > main :: IO ()
-- > main = do
-- >   connection0 <- connectdb "host=localhost port=5432 dbname=exampledb"
-- >   connection1 <- execPQ (define setup) connection0
-- >   connection2 <- flip execPQ connection1 $ do
-- >     idResults <- traversePrepared insertUser (Only . userName <$> users)
-- >     ids <- traverse (fmap fromOnly . getRow (RowNumber 0)) idResults
-- >     traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))
-- >     usersResult <- runQuery getUsers
-- >     usersRows <- getRows usersResult
-- >     liftBase $ print (usersRows :: [User])
-- >   connection3 <- execPQ (define teardown) connection2
-- >   finish connection3

module Squeal.PostgreSQL
  ( module Squeal.PostgreSQL.Binary
  , module Squeal.PostgreSQL.Definition
  , module Squeal.PostgreSQL.Expression
  , module Squeal.PostgreSQL.Manipulation
  , module Squeal.PostgreSQL.PQ
  , module Squeal.PostgreSQL.Query
  , module Squeal.PostgreSQL.Schema
  ) where

import Squeal.PostgreSQL.Binary
import Squeal.PostgreSQL.Definition
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.PQ
import Squeal.PostgreSQL.Query
import Squeal.PostgreSQL.Schema