AppM.hs

module BuyLocal.AppM where

import Prelude
import BuyLocal.Capability.BusinessService (class BusinessRepo)
import BuyLocal.Env (Env)
import BuyLocal.Platform.Database (withConnection)
import Control.Monad.Except (runExceptT)
import Control.Monad.Logger.Class (class MonadLogger)
import Control.Monad.Reader (ask)
import Control.Monad.Reader.Trans (class MonadAsk, ReaderT, asks)
import Data.Bifunctor (lmap)
import Data.Log.Filter (minimumLevel)
import Data.Log.Formatter.JSON (jsonFormatter)
import Data.Log.Level (LogLevel)
import Data.Log.Message (Message)
import Data.Maybe (Maybe(..), fromMaybe)
import Database.PostgreSQL.PG (PGError(..), Query(..), Row0(Row0), Row1(Row1), Row6(Row6), execute, query)
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Console as Console
import Type.Equality (class TypeEquals, from)

newtype AppM a
  = AppM (ReaderT Env Aff a)

derive newtype instance functorAppM :: Functor AppM

derive newtype instance applyAppM :: Apply AppM

derive newtype instance applicativeAppM :: Applicative AppM

derive newtype instance bindAppM :: Bind AppM

derive newtype instance monadAppM :: Monad AppM

derive newtype instance monadAffAppM :: MonadAff AppM

derive newtype instance monadEffectAppM :: MonadEffect AppM

instance monadAskAppM :: TypeEquals e Env => MonadAsk e AppM where
  ask = AppM $ asks from

instance monadLoggerApp :: MonadLogger AppM where
  log :: Message -> AppM Unit
  log message = do
    { logLevel } <- ask
    logMessage logLevel message
    where
    logMessage :: LogLevel -> Message -> AppM Unit
    logMessage logLevel = minimumLevel logLevel $ liftEffect <<< Console.log <<< jsonFormatter

instance businessRepoAppM :: BusinessRepo AppM where
  getBusinesses Nothing = do
    { database } <- ask
    liftAff $ lmap show
      <$> runExceptT do
          withConnection database \conn ->
            query conn (Query "select id, name, image, website, keywords, description, categories, socials from businesses;") Row0
  getBusinesses (Just q) = do
    { database } <- ask
    liftAff $ lmap show
      <$> runExceptT do
          withConnection database \conn ->
            query conn
              ( Query
                  """
                    select businesses.id, businesses.name, businesses.image, businesses.website, businesses.keywords, businesses.description, businesses.categories, businesses.socials from 
                      businesses inner join (
                        select businesses.id as pg_search_id,
                          (ts_rank(
                            (
                              to_tsvector('simple', coalesce(businesses.description::text, '')) ||
                              to_tsvector('simple', coalesce(businesses.keywords::text, '')) ||
                              to_tsvector('simple', coalesce(businesses.name::text, ''))
                            ),
                            (
                              to_tsquery('simple', ''' ' || $1 || ' ''' || ':*')
                            ), 0
                          )) as rank
                          from businesses
                          where ((
                            (
                              to_tsvector('simple', coalesce(businesses.description::text, '')) ||
                              to_tsvector('simple', coalesce(businesses.keywords::text, '')) ||
                              to_tsvector('simple', coalesce(businesses.name::text, ''))
                            ) @@ (
                              to_tsquery('simple', ''' ' || $1 || ' ''' || ':*')
                            )
                          ))
                      ) as pg_search_result on businesses.id = pg_search_result.pg_search_id 
                      order by pg_search_result.rank desc, businesses.id asc
                  """
              )
              (Row1 q)
  createBusiness { name, website, description, categories, socials } createdByIp = do
    { database } <- ask
    liftAff
      $ lmap
          ( case _ of
              ConnectionError error -> error
              ConversionError error -> error
              InternalError error -> error.message
              OperationalError error -> error.message
              ProgrammingError error -> error.message
              IntegrityError error -> error.message
              DataError error -> error.message
              NotSupportedError error -> error.message
              QueryCanceledError error -> error.message
              TransactionRollbackError error -> error.message
          )
      <$> runExceptT do
          withConnection database \conn -> do
            execute conn
              ( Query
                  """
                  insert into businesses (name, website, description, categories, socials, created_by_ip)
                    values ($1, $2, $3, $4, $5, $6);
                  """
              )
              (Row6 name website description categories socials (fromMaybe "" createdByIp))