purescript-selda example using my slightly updated Spago-based fork

SeldaExample.purs

module SeldaExample where

import Prelude

import Control.Monad.Except (ExceptT, runExceptT, throwError)
import Control.Monad.Reader (ReaderT, runReaderT)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Traversable (for_)
import Database.PostgreSQL (Connection, PGError, PoolConfiguration, Query(..), Row0(..), execute, newPool, withConnection)
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Effect.Class.Console (log)
import Selda (Table(..), asc, insert, insert_, limit, lit, orderBy, restrict, (./=), (.<), (.>))
import Selda.PG (selectFrom)
import Type.Data.Row (RProxy(..))
import Type.Row (type (+))

config :: PoolConfiguration
config =
  { user: Just "my_pg_user"
  , password: Just "mypassword"
  , host: Just "127.0.0.1"
  , port: Nothing
  , database: "my_database"
  , max: Nothing
  , idleTimeoutMillis: Just 1000
  }

runSeldaAff
  ∷ ∀ a
  . Connection
  → ExceptT PGError (ReaderT Connection Aff) a
  → Aff a
runSeldaAff conn m = do
  r <- runReaderT (runExceptT m) conn
  case r of
    Left pgError -> throwError $ error $ "PG Error: " <> show pgError
    Right a -> pure a

mkTable :: forall columns. String -> RProxy columns -> Table columns
mkTable name _ = Table { name }

-- | This table includes the 'id' column, a SERIAL integer data type.
-- | When inserting values into this table, we should not use this value
-- | as the types will force us to also specify the 'id' column's value for each
-- | inserted row. (see `names_exampleNoID` instead).
-- | Rather, we should use this version when selecting, updating,
-- | or deleting rows in the table.
names_example :: Table Name_All_Columns
names_example = mkTable "names_example" (RProxy :: RProxy Name_All_Columns)

-- | This table excludes the 'id' column. Thus, we can let the database specify
-- | what the 'id' column's value for each inserted row.
names_exampleNoID :: Table Name_Other_Columns
names_exampleNoID = mkTable "names_example" (RProxy :: RProxy Name_Other_Columns)

-- | To only define these columns once while allowing flexibility in how they
-- | are used, we type alias two rows: one that represents ID columns and
-- | one that represents non-ID columns. We then use `Type.Row (type (+))`
-- | to combine them together
type Name_All_Columns = (Name_ID_Columns + Name_Other_Columns)
type Name_ID_Columns r = (id :: Int | r)
type Name_Other_Columns = (first_name ∷ String, last_name :: String, age :: Int)

main :: Effect Unit
main = do
  launchAff_ do
    pool <- liftEffect $ newPool config
    withConnection pool case _ of
      Left pgError -> log $ "Connection error: " <> show pgError
      Right connection -> do
        -- Set up database
        void $ execute connection (Query """
          DROP TABLE IF EXISTS names_example;

          CREATE TABLE names_example (
            id SERIAL PRIMARY KEY,
            first_name text NOT NULL,
            last_name text NOT NULL,
            age integer NOT NULL
          );
          """) Row0

        -- now use Selda to interact with it
        result <- runSeldaAff connection do
          log $ "Same as 'insert into ... values ... '"
          insert_ names_exampleNoID
            [ { first_name: "Sherry", last_name: "Porker", age: 31 }
            , { first_name: "Cary", last_name: "Porker", age: 41 }
            , { first_name: "Mary", last_name: "Porker", age: 51 }
            ]
          log "\n"

          log $ "Same as 'insert into ... values ... returning ...'"
          results <- insert names_exampleNoID
            [ { first_name: "Bobbert", last_name: "Shubert", age: 12 }
            , { first_name: "Mike", last_name: "Jello", age: 18 }
            , { first_name: "Hopper", last_name: "Stopper", age: 21 }
            , { first_name: "Morion", last_name: "Nygiel", age: 999 }
            ]
          log $ "Returned results are:"
          for_ results \el -> log $ "Element: " <> show el
          log "\n"

          log $ "No ordering made..."
          badlyOrdered <- selectFrom names_example \rec -> do
            pure rec
          for_ badlyOrdered \el -> log $ "Badly Ordered - Element: " <> show el
          log "\n"

          log $ "Ordered by ID..."
          betterOrdered <- selectFrom names_example \rec -> do
            orderBy asc rec.id
            pure rec
          for_ betterOrdered \el -> log $ "Better Ordered - Element: " <> show el
          log "\n"

          log $ "Limited to top 3"
          limited <- selectFrom names_example \rec -> do
            orderBy asc rec.id
            limit 3
            pure rec
          for_ limited \el -> log $ "Limited - Element: " <> show el
          log "\n"

          log $ "Ignore 'Porter' last names"
          noPorkerShown <- selectFrom names_example \rec -> do
            restrict $ rec.last_name ./= lit "Porker"
            orderBy asc rec.id
            limit 3
            pure rec
          for_ noPorkerShown \el -> log $ "No Porker - Element: " <> show el
          log "\n"

          log $ "Select only some columns"
          someColumns <- selectFrom names_example \{ id, last_name, first_name, age} -> do
            restrict $ last_name ./= lit "Porker"
            orderBy asc id
            limit 3
            pure { id, first_name, age }
          for_ someColumns \el -> log $ "Some Columns - Element: " <> show el
          log "\n"

          log $ "Change the order of our PG monadic computations"
          changedOrder <- selectFrom names_example \{ id, last_name, first_name, age} -> do
            limit 3
            restrict $ last_name ./= lit "Porker"
            orderBy asc id
            pure { id, first_name, age }
          for_ changedOrder \el -> log $ "Changed Order - Element: " <> show el
          log "\n"

          log $ "Select even less by adding more expressions in WHERE clause."
          selectLess <- selectFrom names_example \{ id, last_name, first_name, age} -> do
            limit 3
            restrict $ last_name ./= lit "Porker"
            restrict $ age .> lit 20
            restrict $ age .< lit 50
            orderBy asc id
            pure { id, first_name, age }
          for_ selectLess \el -> log $ "Select Less - Element: " <> show el
          log "\n"

        -- we could pattern match on result and do something
        -- but since our last Aff was 'log', it wouldn't matter.
        pure unit

setupDB :: Connection -> Aff Unit
setupDB connection = void $ execute connection (Query """
  DROP TABLE IF EXISTS names_example;

  CREATE TABLE names_example (
    id SERIAL PRIMARY KEY,
    first_name text NOT NULL,
    last_name text NOT NULL,
    age integer NOT NULL
  );
  """) Row0