From 69a3a80411c66a521a74b80cc8ae7f0738b648ed Mon Sep 17 00:00:00 2001
From: Orion Kindel <orionkindel@gmail.com>
Date: Sat, 18 Nov 2023 15:12:09 -0600
Subject: [PATCH] fix: copy from scraper

---
 spago.yaml                      | 181 +++++++++++++++++++++++++++-
 src/Control.Monad.Postgres.purs | 206 ++++++++++++++++++++++++++++++++
 src/Main.purs                   |   7 --
 3 files changed, 383 insertions(+), 11 deletions(-)
 create mode 100644 src/Control.Monad.Postgres.purs
 delete mode 100644 src/Main.purs

diff --git a/spago.yaml b/spago.yaml
index a8c16f6..f3eaa8b 100644
--- a/spago.yaml
+++ b/spago.yaml
@@ -1,21 +1,194 @@
 package:
   dependencies:
-    - prelude
     - aff
+    - console
     - effect
     - either
-    - maybe
     - foldable-traversable
-    - console
+    - foreign
+    - fork
+    - maybe
+    - mmorph
     - newtype
+    - postgresql-client
+    - prelude
     - strings
     - stringutils
     - transformers
     - tuples
     - typelevel-prelude
+    - unlift
   name: project
 workspace:
-  extra_packages: {}
+  extra_packages:
+    postgresql-client:
+      dependencies:
+        - aff
+        - argonaut
+        - arrays
+        - assert
+        - bifunctors
+        - bytestrings
+        - datetime
+        - debug
+        - decimals
+        - dotenv
+        - effect
+        - either
+        - enums
+        - exceptions
+        - foldable-traversable
+        - foreign
+        - foreign-generic
+        - foreign-object
+        - identity
+        - integers
+        - js-date
+        - js-unsafe-stringify
+        - lists
+        - maybe
+        - newtype
+        - node-process
+        - nullable
+        - numbers
+        - ordered-collections
+        - partial
+        - polyform
+        - polyform-batteries-core
+        - polyform-batteries-env
+        - prelude
+        - profunctor
+        - psci-support
+        - record
+        - string-parsers
+        - strings
+        - test-unit
+        - transformers
+        - tuples
+        - typelevel-prelude
+        - unsafe-coerce
+        - validation
+      git: https://github.com/rightfold/purescript-postgresql-client.git
+      ref: main
+    quotient:
+      dependencies: [ "prelude", "quickcheck" ]
+      git: "https://github.com/rightfold/purescript-quotient.git"
+      ref: "v3.0.0"
+    bytestrings:
+      dependencies:
+        [
+          "arrays",
+          "console",
+          "effect",
+          "exceptions",
+          "foldable-traversable",
+          "integers",
+          "leibniz",
+          "maybe",
+          "newtype",
+          "node-buffer",
+          "partial",
+          "prelude",
+          "quickcheck",
+          "quickcheck-laws",
+          "quotient",
+          "unsafe-coerce"
+        ]
+      git: "https://github.com/martyall/purescript-bytestrings.git"
+      ref: "e51cf868a4137c1c48c98d32115bb2014c9f7624"
+    foreign-generic:
+      dependencies:
+        [
+          "arrays",
+          "assert",
+          "bifunctors",
+          "console",
+          "control",
+          "effect",
+          "either",
+          "exceptions",
+          "foldable-traversable",
+          "foreign",
+          "foreign-object",
+          "identity",
+          "lists",
+          "maybe",
+          "newtype",
+          "partial",
+          "prelude",
+          "record",
+          "strings",
+          "transformers",
+          "tuples",
+          "unsafe-coerce"
+        ]
+      git: "https://github.com/paluh/purescript-foreign-generic.git"
+      ref: "a5c23d29e72619624978446293ac9bb45ccd2fde"
+    js-unsafe-stringify:
+      dependencies: []
+      git: "https://github.com/paluh/purescript-js-unsafe-stringify.git"
+      ref: "master"
+    polyform:
+      dependencies:
+        [
+          "heterogeneous",
+          "js-unsafe-stringify",
+          "newtype",
+          "ordered-collections",
+          "variant",
+          "profunctor",
+          "invariant",
+          "foreign-object",
+          "run",
+          "transformers",
+          "validation",
+          "foreign"
+        ]
+      git: "https://github.com/purescript-polyform/polyform.git"
+      ref: "v0.9.2"
+    polyform-batteries-core:
+      dependencies:
+        [
+          "debug",
+          "decimals",
+          "filterable",
+          "numbers",
+          "polyform",
+          "prelude",
+          "record-extra",
+          "test-unit"
+        ]
+      git: "https://github.com/purescript-polyform/batteries-core.git"
+      ref: "v0.3.0"
+    polyform-batteries-urlencoded:
+      dependencies:
+        [
+          "argonaut",
+          "console",
+          "debug",
+          "effect",
+          "form-urlencoded",
+          "polyform-batteries-core",
+          "psci-support",
+          "spec"
+        ]
+      git: "https://github.com/purescript-polyform/batteries-urlencoded.git"
+      ref: "v0.4.1"
+    polyform-batteries-env:
+      dependencies:
+        [
+          "arrays",
+          "identity",
+          "maybe",
+          "ordered-collections",
+          "polyform",
+          "polyform-batteries-core",
+          "prelude",
+          "psci-support",
+          "typelevel-prelude"
+        ]
+      git: "https://github.com/purescript-polyform/batteries-env.git"
+      ref: "v0.2.0"
   package_set:
     url: https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.10-20230930/packages.json
     hash: sha256-nTsd44o7/hrTdk0c6dh0wyBqhFFDJJIeKdQU6L1zv/A=
diff --git a/src/Control.Monad.Postgres.purs b/src/Control.Monad.Postgres.purs
new file mode 100644
index 0000000..785cf6c
--- /dev/null
+++ b/src/Control.Monad.Postgres.purs
@@ -0,0 +1,206 @@
+module Control.Monad.Postgres where
+
+import Prelude
+
+import Control.Alternative (class Alt, class Alternative, class Plus)
+import Control.Monad.Cont (class MonadCont)
+import Control.Monad.Error.Class (class MonadError, class MonadThrow, liftEither, throwError)
+import Control.Monad.Fork.Class
+  ( class MonadBracket
+  , class MonadFork
+  , class MonadKill
+  , bracket
+  , kill
+  , never
+  , uninterruptible
+  )
+import Control.Monad.Morph (class MFunctor, class MMonad, embed, hoist)
+import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask)
+import Control.Monad.Rec.Class (class MonadRec)
+import Control.Monad.Trans.Class (class MonadTrans, lift)
+import Control.Monad.Writer (class MonadTell, class MonadWriter)
+import Control.MonadPlus (class MonadPlus)
+import Control.Parallel (class Parallel, parallel, sequential)
+import Data.Bifunctor (lmap)
+import Data.Either (Either(..))
+import Data.Maybe (maybe)
+import Data.Newtype (class Newtype, unwrap, wrap)
+import Database.PostgreSQL as Pg
+import Database.PostgreSQL.Aff as Pg.Aff
+import Effect.Aff.Class (class MonadAff, liftAff)
+import Effect.Aff.Unlift (class MonadUnliftAff, UnliftAff(..), withUnliftAff)
+import Effect.Class (class MonadEffect)
+import Effect.Exception (Error, error)
+import Foreign (Foreign)
+
+newtype HasPostgresT :: (Type -> Type) -> Type -> Type
+newtype HasPostgresT m a = HasPostgresT (ReaderT Pg.Connection m a)
+
+derive instance Newtype (HasPostgresT m a) _
+derive newtype instance Functor m => Functor (HasPostgresT m)
+derive newtype instance (Plus m) => Plus (HasPostgresT m)
+derive newtype instance (Plus m, Alternative m) => Alternative (HasPostgresT m)
+derive newtype instance Alt m => Alt (HasPostgresT m)
+derive newtype instance Apply m => Apply (HasPostgresT m)
+derive newtype instance Applicative m => Applicative (HasPostgresT m)
+derive newtype instance Bind m => Bind (HasPostgresT m)
+derive newtype instance Monad m => Monad (HasPostgresT m)
+derive newtype instance MonadError e m => MonadError e (HasPostgresT m)
+derive newtype instance MonadThrow e m => MonadThrow e (HasPostgresT m)
+derive newtype instance (Apply m, Semigroup a) => Semigroup (HasPostgresT m a)
+derive newtype instance (Applicative m, Monoid a) => Monoid (HasPostgresT m a)
+derive newtype instance (MonadPlus m) => MonadPlus (HasPostgresT m)
+derive newtype instance (MonadEffect m) => MonadEffect (HasPostgresT m)
+derive newtype instance (MonadAff m) => MonadAff (HasPostgresT m)
+derive newtype instance Monad m => MonadReader Pg.Connection (HasPostgresT m)
+derive newtype instance Monad m => MonadAsk Pg.Connection (HasPostgresT m)
+derive newtype instance MonadCont m => MonadCont (HasPostgresT m)
+derive newtype instance MonadTell w m => MonadTell w (HasPostgresT m)
+derive newtype instance MonadWriter w m => MonadWriter w (HasPostgresT m)
+derive newtype instance MonadRec m => MonadRec (HasPostgresT m)
+derive newtype instance MonadFork f m => MonadFork f (HasPostgresT m)
+derive newtype instance MonadUnliftAff m => MonadUnliftAff (HasPostgresT m)
+instance (Parallel f m) => Parallel (HasPostgresT f) (HasPostgresT m) where
+  parallel = wrap <<< parallel <<< unwrap
+  sequential = wrap <<< sequential <<< unwrap
+
+instance MonadTrans HasPostgresT where
+  lift = wrap <<< lift
+
+instance MFunctor HasPostgresT where
+  hoist f = wrap <<< hoist f <<< unwrap
+
+instance MMonad HasPostgresT where
+  embed f = wrap <<< embed (unwrap <<< f) <<< unwrap
+
+instance MonadKill e f m => MonadKill e f (HasPostgresT m) where
+  kill e f = wrap $ kill e f
+
+instance (MonadKill e f (HasPostgresT m), MonadError e (HasPostgresT m), MonadKill e f m, MonadError e m, MonadBracket e f m) => MonadBracket e f (HasPostgresT m) where
+  bracket acq rel m = wrap $ bracket (unwrap acq) (\b r -> unwrap $ rel b r) (unwrap <<< m)
+  uninterruptible = wrap <<< uninterruptible <<< unwrap
+  never = wrap $ never
+
+newtype PostgresT :: (Type -> Type) -> Type -> Type
+newtype PostgresT m a = PostgresT (ReaderT Pg.Connection m a)
+
+derive instance Newtype (PostgresT m a) _
+derive newtype instance Functor m => Functor (PostgresT m)
+derive newtype instance (Plus m) => Plus (PostgresT m)
+derive newtype instance (Plus m, Alternative m) => Alternative (PostgresT m)
+derive newtype instance Alt m => Alt (PostgresT m)
+derive newtype instance Apply m => Apply (PostgresT m)
+derive newtype instance Applicative m => Applicative (PostgresT m)
+derive newtype instance Bind m => Bind (PostgresT m)
+derive newtype instance Monad m => Monad (PostgresT m)
+derive newtype instance MonadError e m => MonadError e (PostgresT m)
+derive newtype instance MonadThrow e m => MonadThrow e (PostgresT m)
+derive newtype instance (Apply m, Semigroup a) => Semigroup (PostgresT m a)
+derive newtype instance (Applicative m, Monoid a) => Monoid (PostgresT m a)
+derive newtype instance (MonadPlus m) => MonadPlus (PostgresT m)
+derive newtype instance (MonadEffect m) => MonadEffect (PostgresT m)
+derive newtype instance (MonadAff m) => MonadAff (PostgresT m)
+derive newtype instance Monad m => MonadReader Pg.Connection (PostgresT m)
+derive newtype instance Monad m => MonadAsk Pg.Connection (PostgresT m)
+derive newtype instance MonadCont m => MonadCont (PostgresT m)
+derive newtype instance MonadTell w m => MonadTell w (PostgresT m)
+derive newtype instance MonadWriter w m => MonadWriter w (PostgresT m)
+derive newtype instance MonadRec m => MonadRec (PostgresT m)
+derive newtype instance MonadFork f m => MonadFork f (PostgresT m)
+derive newtype instance MonadUnliftAff m => MonadUnliftAff (PostgresT m)
+instance (Parallel f m) => Parallel (PostgresT f) (PostgresT m) where
+  parallel = wrap <<< parallel <<< unwrap
+  sequential = wrap <<< sequential <<< unwrap
+
+instance MonadTrans PostgresT where
+  lift = wrap <<< lift
+
+instance MFunctor PostgresT where
+  hoist f = wrap <<< hoist f <<< unwrap
+
+instance MMonad PostgresT where
+  embed f = wrap <<< embed (unwrap <<< f) <<< unwrap
+
+instance MonadKill e f m => MonadKill e f (PostgresT m) where
+  kill e f = wrap $ kill e f
+
+instance (MonadKill e f (PostgresT m), MonadError e (PostgresT m), MonadKill e f m, MonadError e m, MonadBracket e f m) => MonadBracket e f (PostgresT m) where
+  bracket acq rel m = wrap $ bracket (unwrap acq) (\b r -> unwrap $ rel b r) (unwrap <<< m)
+  uninterruptible = wrap <<< uninterruptible <<< unwrap
+  never = wrap $ never
+
+class MonadHasPostgres :: (Type -> Type) -> (Type -> Type) -> Constraint
+class (MonadPostgres p, MonadAff t) <= MonadHasPostgres p t | t -> p where
+  liftPostgres :: forall a. p a -> t a
+
+instance (MonadUnliftAff m, Monad m, MonadPostgres (PostgresT m)) => MonadHasPostgres (PostgresT m) (HasPostgresT m) where
+  liftPostgres pg = do
+    conn <- ask
+    lift $ runPostgres conn pg
+else instance (MonadUnliftAff m, Monad m, MonadPostgres (PostgresT m)) => MonadHasPostgres (PostgresT m) (PostgresT m) where
+  liftPostgres pg = do
+    conn <- ask
+    lift $ runPostgres conn pg
+else instance
+  ( MMonad t
+  , MonadPostgres (t p)
+  , MonadAff (t h)
+  , MonadHasPostgres p h
+  ) =>
+  MonadHasPostgres (t p) (t h) where
+  liftPostgres = hoist liftPostgres
+
+-- | A monad which can perform logs
+class (Monad m, MonadThrow Error m) <= MonadPostgres m where
+  query :: forall @a. Pg.FromSQLRow a => String -> m (Array a)
+  queryP :: forall @a. Pg.FromSQLRow a => Array Foreign -> String -> m (Array a)
+  exec :: String -> m Unit
+  execP :: Array Foreign -> String -> m Unit
+  transaction :: forall a. m a -> m a
+
+instance (MonadUnliftAff m, MonadThrow Error m) => MonadPostgres (PostgresT m) where
+  query q = do
+    conn <- ask
+    res <- liftAff $ Pg.Aff.query conn (Pg.Query q) Pg.Row0
+    liftEither $ lmap (error <<< show) $ res
+  queryP ps q = do
+    conn <- ask
+    res <- liftAff $ Pg.Aff.query conn (Pg.Query q) ps
+    liftEither $ lmap (error <<< show) $ res
+  exec q = do
+    conn <- ask
+    res <- liftAff $ Pg.Aff.execute conn (Pg.Query q) Pg.Row0
+    liftEither $ lmap (error <<< show) $ maybe (Right unit) Left $ res
+  execP ps q = do
+    conn <- ask
+    res <- liftAff $ Pg.Aff.execute conn (Pg.Query q) ps
+    liftEither $ lmap (error <<< show) $ maybe (Right unit) Left $ res
+  transaction pg = do
+    conn :: Pg.Connection <- ask
+    let pgToM c = runPostgres c pg
+    case unwrap conn of
+      Right _ -> throwError $ error $ "Transactions can only be run with access to the pool!"
+      Left pool -> lift $ withUnliftAff \(UnliftAff mToAff) -> do
+        res <- liftAff $ Pg.Aff.withTransaction pool $ mToAff <<< pgToM
+        liftEither $ lmap (error <<< show) $ res
+else instance (MonadUnliftAff m, Monad (t m), MonadThrow Error (t m), MMonad t, MonadPostgres m) => MonadPostgres (t m) where
+  query q = lift $ query q
+  queryP ps q = lift $ queryP ps q
+  exec q = lift $ exec q
+  execP ps q = lift $ execP ps q
+  transaction = hoist transaction
+
+runPostgres :: forall m a. Pg.Connection -> PostgresT m a -> m a
+runPostgres conn t = (unwrap $ unwrap t) conn
+
+runHasPostgres :: forall m a. Pg.Connection -> HasPostgresT m a -> m a
+runHasPostgres conn t = (unwrap $ unwrap t) conn
+
+newtype RawRow = RawRow (Array Foreign)
+
+derive instance Newtype RawRow _
+instance Pg.FromSQLRow RawRow where
+  fromSQLRow = pure <<< wrap
+
+instance Pg.ToSQLRow RawRow where
+  toSQLRow = unwrap
diff --git a/src/Main.purs b/src/Main.purs
deleted file mode 100644
index ee561ac..0000000
--- a/src/Main.purs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Main where
-
-import Prelude
-import Effect (Effect)
-
-main :: Effect Unit
-main = pure unit