From 4dd23d561eaa6c782a7db8dbf978249cc0eefa74 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Sat, 2 Sep 2023 03:39:17 +0200 Subject: [PATCH] Project setup and implementation sketch --- .gitignore | 2 + LICENSE | 20 ++++++ flake.lock | 25 +++++++ flake.nix | 30 +++++++++ hie.yaml | 7 ++ lib/Database/PostgreSQL/Opium.hs | 63 ++++++++++++++++++ opium.cabal | 110 +++++++++++++++++++++++++++++++ test/Main.hs | 18 +++++ 8 files changed, 275 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 hie.yaml create mode 100644 lib/Database/PostgreSQL/Opium.hs create mode 100644 opium.cabal create mode 100644 test/Main.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bf3bce8 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +dist-newstyle/ +*.swp diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..6aad4dd --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2023 Paul Brinkmeier + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..c428cc4 --- /dev/null +++ b/flake.lock @@ -0,0 +1,25 @@ +{ + "nodes": { + "nixpkgs": { + "locked": { + "lastModified": 1681753173, + "narHash": "sha256-MrGmzZWLUqh2VstoikKLFFIELXm/lsf/G9U9zR96VD4=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0a4206a51b386e5cda731e8ac78d76ad924c7125", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "nixpkgs": "nixpkgs" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..806eaa2 --- /dev/null +++ b/flake.nix @@ -0,0 +1,30 @@ +{ + description = "An opionated Postgres library"; + + outputs = { self, nixpkgs }: + let + pkgs = nixpkgs.legacyPackages.x86_64-linux; + in { + apps.x86_64-linux.cabal = { + type = "app"; + program = "${nixpkgs.legacyPackages.x86_64-linux.cabal-install}/bin/cabal"; + }; + devShells.x86_64-linux.default = pkgs.mkShell { + packages = [ + pkgs.cabal-install + pkgs.haskellPackages.implicit-hie + (pkgs.ghc.withPackages (hp: with hp; [ + containers + bytestring + postgresql-libpq + text + ])) + + pkgs.haskell-language-server + ]; + shellHook = '' + PS1=" ''${PS1}" + ''; + }; + }; +} diff --git a/hie.yaml b/hie.yaml new file mode 100644 index 0000000..1d32b5b --- /dev/null +++ b/hie.yaml @@ -0,0 +1,7 @@ +cradle: + cabal: + - path: "lib" + component: "lib:opium" + + - path: "test" + component: "opium:test:opium-test" diff --git a/lib/Database/PostgreSQL/Opium.hs b/lib/Database/PostgreSQL/Opium.hs new file mode 100644 index 0000000..373f9bf --- /dev/null +++ b/lib/Database/PostgreSQL/Opium.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Database.PostgreSQL.Opium where + +import Data.ByteString (ByteString) +import Data.Proxy (Proxy (Proxy)) +import Database.PostgreSQL.LibPQ + (Result + , Row + ) +import GHC.Generics (C, D, Generic, K1 (..), M1 (..), Meta (..), Rec0, Rep, S, to, (:*:) (..)) +import GHC.TypeLits (KnownSymbol, symbolVal) +import Text.Printf (printf) + +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding +import qualified Database.PostgreSQL.LibPQ as LibPQ + +class FromRow a where + fromRow :: Row -> Result -> IO (Maybe a) + default fromRow :: (Generic a, FromRow' (Rep a)) => Row -> Result -> IO (Maybe a) + fromRow row result = fmap to <$> fromRow' row result + +class FromRow' f where + fromRow' :: Row -> Result -> IO (Maybe (f p)) + +instance FromRow' f => FromRow' (M1 D c f) where + fromRow' row result = fmap M1 <$> fromRow' row result + +instance FromRow' f => FromRow' (M1 C c f) where + fromRow' row result = fmap M1 <$> fromRow' row result + +instance (FromRow' f, FromRow' g) => FromRow' (f :*: g) where + fromRow' row result = do + y <- fromRow' row result + z <- fromRow' row result + pure $ (:*:) <$> y <*> z + +instance (KnownSymbol nameSym, FromField t) => FromRow' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where + fromRow' row result = do + mbColumn <- LibPQ.fnumber result name + case mbColumn of + Nothing -> pure Nothing + Just column -> do + mbField <- LibPQ.getvalue result row column + printf "%s: %s" (show name) (show mbField) + pure $ M1 . K1 <$> fromField mbField + where + name = Encoding.encodeUtf8 $ Text.pack $ symbolVal (Proxy :: Proxy nameSym) + +class FromField a where + fromField :: Maybe ByteString -> Maybe a + +instance FromField String where + fromField = fmap (Text.unpack . Encoding.decodeUtf8) + +instance FromField Int where + fromField = fmap (read . Text.unpack . Encoding.decodeUtf8) diff --git a/opium.cabal b/opium.cabal new file mode 100644 index 0000000..e9a4150 --- /dev/null +++ b/opium.cabal @@ -0,0 +1,110 @@ +cabal-version: 3.0 +-- The cabal-version field refers to the version of the .cabal specification, +-- and can be different from the cabal-install (the tool) version and the +-- Cabal (the library) version you are using. As such, the Cabal (the library) +-- version used must be equal or greater than the version stated in this field. +-- Starting from the specification version 2.2, the cabal-version field must be +-- the first thing in the cabal file. + +-- Initial package description 'opium' generated by +-- 'cabal init'. For further documentation, see: +-- http://haskell.org/cabal/users-guide/ +-- +-- The name of the package. +name: opium + +-- The package version. +-- See the Haskell package versioning policy (PVP) for standards +-- guiding when and how versions should be incremented. +-- https://pvp.haskell.org +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +-- synopsis: + +-- A longer description of the package. +-- description: + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Paul Brinkmeier + +-- An email address to which users can send suggestions, bug reports, and patches. +maintainer: hallo@pbrinkmeier.de + +-- A copyright notice. +-- copyright: +category: Database +build-type: Simple + +-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. +-- extra-doc-files: CHANGELOG.md + +-- Extra source files to be distributed with the package, such as examples, or a tutorial module. +-- extra-source-files: + +common warnings + ghc-options: -Wall + +library + -- Import common warning flags. + import: warnings + + -- Modules exported by the library. + exposed-modules: + Database.PostgreSQL.Opium + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: + base, + bytestring, + containers, + postgresql-libpq, + text + + -- Directories containing source files. + hs-source-dirs: lib + + -- Base language which the package is written in. + default-language: Haskell2010 + +test-suite opium-test + -- Import common warning flags. + import: warnings + + -- Base language which the package is written in. + default-language: Haskell2010 + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- The interface type and version of the test suite. + type: exitcode-stdio-1.0 + + -- Directories containing source files. + hs-source-dirs: test + + -- The entrypoint to the test suite. + main-is: Main.hs + + -- Test dependencies. + build-depends: + base, + opium diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..d4c1af3 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Main (main) where + +import GHC.Generics (Generic) + +import Database.PostgreSQL.Opium (FromRow) + +data Person = Person + { name :: String + , age :: Int +-- , lovesCats :: Bool + } deriving (Generic) + +instance FromRow Person where + +main :: IO () +main = putStrLn "TBD"