quokka (empty) → 0.1.0.0
raw patch · 12 files changed
+911/−0 lines, 12 filesdep +basedep +hspecdep +pcre-utilssetup-changed
Dependencies added: base, hspec, pcre-utils, postgresql-simple, quokka, raw-strings-qq, regex-pcre-builtin, text
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- Setup.hs +2/−0
- quokka.cabal +60/−0
- src/Quokka/Functions.hs +228/−0
- src/Quokka/Text/Countable.hs +151/−0
- src/Quokka/Text/Data.hs +110/−0
- src/Quokka/Types.hs +68/−0
- test/Quokka/CreateSpec.hs +124/−0
- test/Quokka/Helper.hs +70/−0
- test/Quokka/Tables.hs +60/−0
- test/Spec.hs +12/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for quokka++## 0.1.0.0 -- 2019-10-30 ++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Shirren Premaratne++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ quokka.cabal view
@@ -0,0 +1,60 @@+cabal-version: >=1.10+name: quokka+version: 0.1.0.0+license: MIT+license-file: LICENSE+author: Shirren Premaratne+maintainer: shirren.premaratne@gmail.com+build-type: Simple+homepage: https://github.com/shirren/quokka+bug-reports: https://github.com/shirren/quokka/issues+category: Database, Testing+extra-source-files: CHANGELOG.md+ LICENSE+synopsis:+ Test helpers which help generate data for projects that use postgresql.+description:+ Quokka is a library that helps generate test data for projects that use postgresql. The+ generated test data is inserted into Postgres for access by libraries such as Beam, Traction+ and postgresql-simple etc.++source-repository head+ type: git+ location: https://github.com/shirren/quokka.git++library+ exposed-modules: Quokka.Functions+ , Quokka.Types+ other-modules: Quokka.Text.Countable+ , Quokka.Text.Data+ build-depends: base >=4.11 && <5+ , postgresql-simple >=0.6 && <0.7+ , regex-pcre-builtin >=0.95 && <1+ , pcre-utils >= 0.1 && < 0.2+ , text >=1.2 && <1.3+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wmissing-import-lists++test-suite quokka-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules: Quokka.CreateSpec+ , Quokka.Helper+ , Quokka.Tables+ build-depends: base >=4.11 && <5+ , hspec >= 2 && < 2.8+ , postgresql-simple >=0.6 && <0.7+ , quokka+ , raw-strings-qq >= 1.1 && < 1.2+ , text >=1.2 && <1.3+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -- -Wmissing-import-lists+ -threaded
+ src/Quokka/Functions.hs view
@@ -0,0 +1,228 @@+-- |+-- Module : Quokka.Functions+-- Copyright : © 2019 Shirren Premaratne+-- License : MIT+--+-- Maintainer : Shirren Premaratne <shirren.premaratne@gmail.com>+-- Stability : stable+-- Portability : portable+--+-- Functions to generate Postgres data via the postgres-simple library.++{-# LANGUAGE OverloadedStrings #-}++module Quokka.Functions (+ build+, build1+, buildWith1Rel+, build1With1Rel+, buildWithManyRels+, build1WithManyRels+, delete+, deleteStatement+, id'+, insertStatement+, insertStatementWith1Rel+, insertStatementWithManyRels+, mapFromIdToResult+) where++import Data.Int (Int64)+import Data.Text (intercalate)+import Data.Text.Encoding (encodeUtf8)+import Database.PostgreSQL.Simple (Connection, ToRow, execute_, returning, query)+import Database.PostgreSQL.Simple.Types (Query (Query))+import Quokka.Types (ChildTable (ChildTable)+ , Id (getId)+ , ParentTable (ParentTable)+ , Table (Table)+ , Result (SingleResult))+import Quokka.Text.Countable (singularize)+++-- Build a prepared statement to insert data into the database`+build+ :: (ToRow q)+ => Connection+ -> ParentTable+ -> [q]+ -> IO [Id]+build conn tbl =+ let+ qry = insertStatement tbl+ in+ returning conn qry+++-- Similar to the build function but we only ever return+-- a single optional result, and only take 1 value.+build1+ :: (ToRow q)+ => Connection+ -> ParentTable+ -> q+ -> IO (Maybe Id)+build1 conn tbl =+ let+ qry = insertStatement tbl+ in+ fmap build1Helper . query conn qry+++-- Build a prepared statement for a child table with a single foreign+-- key table+buildWith1Rel+ :: (ToRow q)+ => Connection+ -> ParentTable+ -> ChildTable+ -> [q]+ -> IO [Id]+buildWith1Rel conn parent child =+ let+ qry = insertStatementWith1Rel parent child+ in+ returning conn qry+++-- Build a prepared statement for a child table with a single foreign+-- key table+build1With1Rel+ :: (ToRow q)+ => Connection+ -> ParentTable+ -> ChildTable+ -> q+ -> IO (Maybe Id)+build1With1Rel conn parent child =+ let+ qry = insertStatementWith1Rel parent child+ in+ fmap build1Helper . query conn qry+++-- Build a prepared statement for a child table with more than 1 parent+buildWithManyRels+ :: (ToRow q)+ => Connection+ -> [ParentTable]+ -> ChildTable+ -> [q]+ -> IO [Id]+buildWithManyRels conn parents child =+ let+ qry = insertStatementWithManyRels parents child+ in+ returning conn qry+++-- Build a prepared statement for a child table with more than 1 parent+build1WithManyRels+ :: (ToRow q)+ => Connection+ -> [ParentTable]+ -> ChildTable+ -> q+ -> IO (Maybe Id)+build1WithManyRels conn parents child =+ let+ qry = insertStatementWithManyRels parents child+ in+ fmap build1Helper . query conn qry+++-- Perform a truncate with cascade action on the Table+delete+ :: Connection+ -> Table+ -> IO Int64+delete conn tbl = do+ let+ alter = alterSequenceStatement tbl+ qry = deleteStatement tbl+ _ <- execute_ conn alter+ execute_ conn qry+++-- Create an insert statement for a table+insertStatement+ :: ParentTable+ -> Query+insertStatement (ParentTable name columns) =+ let+ columnsAsText = intercalate "," columns+ valuesAsText = intercalate "," (map (const "?") columns)+ baseInsert = "insert into " <> name <> " (" <> columnsAsText <> ")"+ in+ Query (encodeUtf8 $ baseInsert <> " values (" <> valuesAsText <> ") returning id;")+++-- Creates an insert statement for a table, and uses the parent table to also incude+-- a foreign key in the generation of the statement.+insertStatementWith1Rel+ :: ParentTable+ -> ChildTable+ -> Query+insertStatementWith1Rel parent =+ insertStatementWithManyRels [parent]+++-- Creates an insert statement for a table, and uses multiple parent tables to also incude+-- foreign keys in the generation of the statement.+insertStatementWithManyRels+ :: [ParentTable]+ -> ChildTable+ -> Query+insertStatementWithManyRels parents (ChildTable name columns) =+ let+ updatedColumns = columns ++ map (\(ParentTable parentName _) -> singularize parentName <> "_id") parents+ columnsAsText = intercalate "," updatedColumns+ valuesAsText = intercalate "," (map (const "?") updatedColumns)+ baseInsert = "insert into " <> name <> " (" <> columnsAsText <> ")"+ in+ Query (encodeUtf8 $ baseInsert <> " values (" <> valuesAsText <> ") returning id;")+++-- Generate an alter sequence statement for a table+alterSequenceStatement+ :: Table+ -> Query+alterSequenceStatement (Table name) =+ Query (encodeUtf8 $ "alter sequence " <> name <> "_id_seq restart;")+++-- Generate a delete statement for a table+deleteStatement+ :: Table+ -> Query+deleteStatement (Table name) =+ Query (encodeUtf8 $ "truncate table " <> name <> " cascade;")+++-- Helper function to extract the underlying Int value from+-- the first value in the list+id' :: [Id] -> Int+id' (x:_) =+ getId x+id' [] =+ -1++-- Postgres Simple does not have a function which maps from [r] -> Maybe r+-- so we've written one that takes the head or returns Nothing in a safe+-- manner.+build1Helper+ :: [Id]+ -> Maybe Id+build1Helper (x:_) =+ Just x+build1Helper [] =+ Nothing+++-- Function to map from IO [Id] -> IO [Result]+mapFromIdToResult+ :: ParentTable+ -> [Id]+ -> [Result]+mapFromIdToResult tbl =+ map (SingleResult tbl)
+ src/Quokka/Text/Countable.hs view
@@ -0,0 +1,151 @@+-- |+-- Module : Text.Countable+-- Copyright : © 2016 Brady Ouren+-- License : MIT+--+-- Maintainer : Brady Ouren <brady.ouren@gmail.com>+-- Stability : stable+-- Portability : portable+--+-- pluralization and singularization transformations+--+-- Note: This library is portable in the sense of haskell extensions+-- however, it is _not_ portable in the sense of requiring PCRE regex+-- bindings on the system++{-# LANGUAGE OverloadedStrings #-}++module Quokka.Text.Countable+ ( pluralize+ , pluralizeWith+ , singularize+ , singularizeWith+ , inflect+ , inflectWith+ , makeMatchMapping+ , makeIrregularMapping+ , makeUncountableMapping+ )+where++import Data.Maybe (catMaybes, fromMaybe, isJust)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Quokka.Text.Data (defaultUncountables', defaultIrregulars', defaultSingulars', defaultPlurals')+import Text.Regex.PCRE.ByteString (Regex, execBlank, compCaseless, compile, execute)+import Text.Regex.PCRE.ByteString.Utils (substitute')+import System.IO.Unsafe (unsafePerformIO)++type RegexPattern = Text+type RegexReplace = Text+type Singular = Text+type Plural = Text++data Inflection+ = Simple (Singular, Plural)+ | Match (Maybe Regex, RegexReplace)++-- pluralize a word given a default mapping+pluralize :: Text -> Text+pluralize = pluralizeWith mapping+ where+ mapping = defaultIrregulars ++ defaultUncountables ++ defaultPlurals++-- singularize a word given a default mapping+singularize :: Text -> Text+singularize = singularizeWith mapping+ where+ mapping = defaultIrregulars ++ defaultUncountables ++ defaultSingulars++-- pluralize a word given a custom mapping.+-- Build the [Inflection] with a combination of+-- `makeUncountableMapping` `makeIrregularMapping` `makeMatchMapping`+pluralizeWith :: [Inflection] -> Text -> Text+pluralizeWith = lookupWith pluralLookup++-- singularize a word given a custom mapping.+-- Build the [Inflection] with a combination of+-- `makeUncountableMapping` `makeIrregularMapping` `makeMatchMapping`+singularizeWith :: [Inflection] -> Text -> Text+singularizeWith = lookupWith singularLookup++-- inflect a word given any number+inflect :: Text -> Int -> Text+inflect t i = case i of+ 1 -> singularize t+ _ -> pluralize t++-- inflect a word given any number and inflection mapping+inflectWith :: [Inflection] -> Text -> Int -> Text+inflectWith l t i = case i of+ 1 -> singularizeWith l t+ _ -> pluralizeWith l t++lookupWith :: (Text -> Inflection -> Maybe Text) -> [Inflection] -> Text -> Text+lookupWith f mapping target = fromMaybe target $ headMaybe matches+ where+ matches = catMaybes $ fmap (f target) (Prelude.reverse mapping)++-- Makes a simple list of mappings from singular to plural, e.g [("person", "people")]+-- the output of [Inflection] should be consumed by `singularizeWith` or `pluralizeWith`+makeMatchMapping :: [(RegexPattern, RegexReplace)] -> [Inflection]+makeMatchMapping = fmap (\(pat, rep) -> Match (regexPattern pat, rep))++-- Makes a simple list of mappings from singular to plural, e.g [("person", "people")]+-- the output of [Inflection] should be consumed by `singularizeWith` or `pluralizeWith`+makeIrregularMapping :: [(Singular, Plural)] -> [Inflection]+makeIrregularMapping = fmap Simple++-- Makes a simple list of uncountables which don't have+-- singular plural versions, e.g ["fish", "money"]+-- the output of [Inflection] should be consumed by `singularizeWith` or `pluralizeWith`+makeUncountableMapping :: [Text] -> [Inflection]+makeUncountableMapping = fmap (\a -> Simple (a,a))+++defaultPlurals :: [Inflection]+defaultPlurals = makeMatchMapping defaultPlurals'++defaultSingulars :: [Inflection]+defaultSingulars = makeMatchMapping defaultSingulars'++defaultIrregulars :: [Inflection]+defaultIrregulars = makeIrregularMapping defaultIrregulars'++defaultUncountables :: [Inflection]+defaultUncountables = makeUncountableMapping defaultUncountables'++pluralLookup :: Text -> Inflection -> Maybe Text+pluralLookup t (Match (r1,r2)) = runSub (r1,r2) t+pluralLookup t (Simple (a,b)) = if t == a then Just b else Nothing++singularLookup :: Text -> Inflection -> Maybe Text+singularLookup t (Match (r1,r2)) = runSub (r1,r2) t+singularLookup t (Simple (a,b)) = if t == b then Just a else Nothing++runSub :: (Maybe Regex, RegexReplace) -> Text -> Maybe Text+runSub (Nothing, _) _ = Nothing+runSub (Just reg, rep) t = matchWithReplace (reg, rep) t++matchWithReplace :: (Regex, RegexReplace) -> Text -> Maybe Text+matchWithReplace (reg, rep) t =+ if regexMatch t reg+ then toMaybe $ substitute' reg (encodeUtf8 t) (encodeUtf8 rep)+ else Nothing+ where+ toMaybe = either (const Nothing) (Just . decodeUtf8)++regexMatch :: Text -> Regex -> Bool+regexMatch t r = case match of+ Left _ -> False+ Right m -> isJust m+ where match = unsafePerformIO $ execute r (encodeUtf8 t)++regexPattern :: Text -> Maybe Regex+regexPattern pat = toMaybe reg+ where toMaybe = either (const Nothing) Just+ reg = unsafePerformIO $ compile compCaseless execBlank (encodeUtf8 pat)++headMaybe :: [a] -> Maybe a+headMaybe [] = Nothing+headMaybe (x:_) = Just x
+ src/Quokka/Text/Data.hs view
@@ -0,0 +1,110 @@+-- |+-- Module : Text.Countable+-- Copyright : © 2016 Brady Ouren+-- License : MIT+--+-- Maintainer : Brady Ouren <brady.ouren@gmail.com>+-- Stability : stable+-- Portability : portable+--+-- pluralization and singularization transformations+--+-- Note: This library is portable in the sense of haskell extensions+-- however, it is _not_ portable in the sense of requiring PCRE regex+-- bindings on the system++{-# LANGUAGE OverloadedStrings #-}++module Quokka.Text.Data where++import Data.Text (Text)+++-- These default inflections stolen from the Ruby inflection library - see+-- https://github.com/rails/rails/blob/master/activesupport/lib/active_support/inflections.rb+defaultPlurals' :: [(Text, Text)]+defaultPlurals' =+ [ ("$", "s")+ , ("s$", "s")+ , ("^(ax|test)is$", "\\1es")+ , ("(octop|vir)us$", "\\1i")+ , ("(octop|vir)i$", "\\1i")+ , ("(alias|status)$", "\\1es")+ , ("(bu)s$", "\\1ses")+ , ("(buffal|tomat)o$", "\\1oes")+ , ("([ti])um$", "\\1a")+ , ("([ti])a$", "\\1a")+ , ("sis$", "ses")+ , ("(?:([^f])fe|([lr])f)$", "\\1\2ves")+ , ("(hive)$", "\\1s")+ , ("([^aeiouy]|qu)y$", "\\1ies")+ , ("(x|ch|ss|sh)$", "\\1es")+ , ("(matr|vert|ind)(?:ix|ex)$", "\\1ices")+ , ("^(m|l)ouse$", "\\1ice")+ , ("^(m|l)ice$", "\\1ice")+ , ("^(ox)$", "\\1en")+ , ("^(oxen)$", "\\1")+ , ("(quiz)$", "\\1zes")+ ]++-- These default inflections stolen from the Ruby inflection library - see+-- https://github.com/rails/rails/blob/master/activesupport/lib/active_support/inflections.rb+defaultSingulars' :: [(Text, Text)]+defaultSingulars' =+ [ ("s$", "")+ , ("(ss)$", "\\1")+ , ("(n)ews$", "\\1ews")+ , ("([ti])a$", "\\1um")+ , ("((a)naly|(b)a|(d)iagno|(p)arenthe|(p)rogno|(s)ynop|(t)he)(sis|ses)$", "\\1sis")+ , ("(^analy)(sis|ses)$", "\\1sis")+ , ("([^f])ves$", "\\1fe")+ , ("(hive)s$", "\\1")+ , ("(tive)s$", "\\1")+ , ("([lr])ves$", "\\1f")+ , ("([^aeiouy]|qu)ies$", "\\1y")+ , ("(s)eries$", "\\1eries")+ , ("(m)ovies$", "\\1ovie")+ , ("(x|ch|ss|sh)es$", "\\1")+ , ("^(m|l)ice$", "\\1ouse")+ , ("(bus)(es)?$", "\\1")+ , ("(o)es$", "\\1")+ , ("(shoe)s$", "\\1")+ , ("(cris|test)(is|es)$", "\\1is")+ , ("^(a)x[ie]s$", "\\1xis")+ , ("(octop|vir)(us|i)$", "\\1us")+ , ("(alias|status)(es)?$", "\\1")+ , ("^(ox)en", "\\1")+ , ("(vert|ind)ices$", "\\1ex")+ , ("(matr)ices$", "\\1ix")+ , ("(quiz)zes$", "\\1")+ , ("(database)s$", "\\1")+ ]++-- These default irregular inflections stolen from the Ruby inflection library - see+-- https://github.com/rails/rails/blob/master/activesupport/lib/active_support/inflections.rb+defaultIrregulars' :: [(Text, Text)]+defaultIrregulars' =+ -- from singular to plural+ [ ("person", "people")+ , ("man", "men")+ , ("child", "children")+ , ("sex", "sexes")+ , ("move", "moves")+ , ("zombie", "zombies")+ ]++-- These default uncountable inflections stolen from the Ruby inflection library - see+-- https://github.com/rails/rails/blob/master/activesupport/lib/active_support/inflections.rb+defaultUncountables' :: [Text]+defaultUncountables' =+ [ "equipment"+ , "information"+ , "rice"+ , "money"+ , "species"+ , "series"+ , "fish"+ , "sheep"+ , "jeans"+ , "police"+ ]
+ src/Quokka/Types.hs view
@@ -0,0 +1,68 @@+-- |+-- Module : Quokka.Types+-- Copyright : © 2019 Shirren Premaratne+-- License : MIT+--+-- Maintainer : Shirren Premaratne <shirren.premaratne@gmail.com>+-- Stability : stable+-- Portability : portable+--+-- Types used by the Functions to generate test data and represent data+-- and relational associations.++module Quokka.Types (+ ChildTable (..)+, Data+, Id (..)+, ParentTable (..)+, Table (..)+, Result (..)+, Row (..)+) where++import Data.Text (Text)+import Database.PostgreSQL.Simple (FromRow, ToRow)+import Database.PostgreSQL.Simple.FromRow (fromRow, field)+import Database.PostgreSQL.Simple.ToRow (toRow)+import Database.PostgreSQL.Simple.ToField (toField, ToField)+++type Data = [Text]+++-- Represents the identity column of a row in a table. I.e. the+-- primary key of a table which is limited to integers.+newtype Id+ = Id { getId :: Int }+ deriving (Eq, Show)++instance FromRow Id where+ fromRow =+ Id <$> field++instance ToField Id where+ toField (Id val) =+ toField val+++data ChildTable+ = ChildTable Text [Text]+++data ParentTable+ = ParentTable Text [Text]+++newtype Table+ = Table Text++data Result+ = SingleResult ParentTable Id+++newtype Row a+ = Row [a]++instance ToField a => ToRow (Row a) where+ toRow (Row xs) =+ map toField xs
+ test/Quokka/CreateSpec.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE OverloadedStrings #-}++module Quokka.CreateSpec (+ spec+) where++import Data.Maybe (fromJust)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Database.PostgreSQL.Simple.Types (Query (Query))+import Quokka.Types (ChildTable (..), Id (..), ParentTable (..))+import Quokka.Functions (build1+ , build1With1Rel+ , id'+ , insertStatement+ , insertStatementWith1Rel+ , insertStatementWithManyRels)+import Quokka.Helper (setupDb, withDatabaseConnection)+import Quokka.Tables (accountTableAsChild+ , insertAccounts+ , insertProfiles+ , insertUsers+ , userTable)+import Test.Hspec+++spec :: Spec+spec = do+ describe "insertStatement" $ do+ it "should return an insert statement for a single column" $ do+ let+ table = ParentTable "users" ["name"]++ insertStatement table `shouldBe` Query "insert into users (name) values (?) returning id;"+++ it "should return an insert statement for multiple columns" $ do+ let+ table = ParentTable "users" ["firstname", "lastname"]++ insertStatement table `shouldBe` Query "insert into users (firstname,lastname) values (?,?) returning id;"+++ describe "insertStatementWith1Rel" $+ it "should return an insert statement with the FK set" $ do+ let+ parentTable = ParentTable "users" ["firstname", "lastname", "age"]+ childTable = ChildTable "accounts" ["name"]+ Query stmt = insertStatementWith1Rel parentTable childTable++ stmt `shouldBe` encodeUtf8 "insert into accounts (name,user_id) values (?,?) returning id;"+++ describe "insertStatementWithManyRels" $ do+ context "for 2 parent tables" $+ it "should return an insert statement with 2 FKs set" $ do+ let+ parentTable1 = ParentTable "users" ["firstname", "lastname", "age"]+ parentTable2 = ParentTable "accounts" ["name"]+ childTable = ChildTable "profiles" ["active"]+ Query stmt = insertStatementWithManyRels [parentTable1, parentTable2] childTable++ stmt `shouldBe` encodeUtf8 "insert into profiles (active,user_id,account_id) values (?,?,?) returning id;"+++ context "for no parents" $+ it "should return an insert statement with no FKs set" $ do+ let+ childTable = ChildTable "profiles" ["active"]+ Query stmt = insertStatementWithManyRels [] childTable++ stmt `shouldBe` encodeUtf8 "insert into profiles (active) values (?) returning id;"+++ before_ setupDb $+ around withDatabaseConnection $ do+ describe "insert1" $ do+ context "for a table with no relationships" $+ it "should insert a single row into the database" $ \conn -> do+ let insertUser = build1 conn userTable+ userId <- insertUser ("John" :: Text, "Doe" :: Text, Just 1 :: Maybe Int)++ userId `shouldBe` Just (Id 1)+++ context "for a table with a single relationship" $+ it "should insert parent and child into the database" $ \conn -> do+ let+ insertUser = build1 conn userTable+ insertAccount = build1With1Rel conn userTable accountTableAsChild+ userId <- insertUser ("John" :: Text, "Doe" :: Text, 1 :: Int)+ accountId <- insertAccount ("Account-1" :: Text, "Description" :: Text, fromJust userId)++ accountId `shouldBe` Just (Id 1)+++ describe "insert" $ do+ context "for a table with no relationships" $+ it "should insert data into the database" $ \conn -> do+ userIds <- insertUsers conn [+ ("John" :: Text, "Doe" :: Text, Just 1 :: Maybe Int)+ , ("Jane" :: Text, "Doe" :: Text, Nothing)]++ length userIds `shouldBe` 2+++ context "for a table with a single relationship" $+ it "should insert parent and child into the database" $ \conn -> do+ userIds <- insertUsers conn [("John" :: Text, "Doe" :: Text, 1 :: Int)]+ accountIds <- insertAccounts conn [("Account-1" :: Text, "Description" :: Text, id' userIds)]++ length userIds `shouldBe` 1+ length accountIds `shouldBe` 1+++ context "for a table with multiple relationships" $+ it "should insert parent and children into the database" $ \conn -> do+ userIds <- insertUsers conn [("John" :: Text, "Doe" :: Text, 1 :: Int)]+ accountIds <- insertAccounts conn [("Account-1" :: Text, "Description" :: Text, id' userIds)]+ profileIds <- insertProfiles conn [(True :: Bool, id' userIds, id' accountIds)]++ length userIds `shouldBe` 1+ length accountIds `shouldBe` 1+ length profileIds `shouldBe` 1
+ test/Quokka/Helper.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Quokka.Helper (+ openConnection+, closeConnection+, withDatabaseConnection+, setupDb+) where++import Control.Exception (bracket)+import Data.Functor (void)+import Data.Int (Int64)+import Database.PostgreSQL.Simple+import Quokka.Functions (delete)+import Quokka.Types (Table (..))+import Text.RawString.QQ+++openConnection :: IO Connection+openConnection =+ connect defaultConnectInfo { connectPassword = "quokka_test"+ , connectDatabase = "quokka_test"+ , connectUser = "quokka_test"+ }+++closeConnection :: Connection -> IO ()+closeConnection =+ close+++withDatabaseConnection :: (Connection -> IO ()) -> IO ()+withDatabaseConnection =+ bracket openConnection closeConnection+++setupDb :: IO ()+setupDb = do+ conn <- openConnection+ void $ buildTables conn+ flushDb conn+++flushDb :: Connection -> IO ()+flushDb conn = do+ void $ delete conn (Table "users")+ void $ delete conn (Table "accounts")+ void $ delete conn (Table "profiles")+ closeConnection conn+++buildTables :: Connection -> IO Int64+buildTables conn = do+ void $ execute_ conn [r|create table if not exists users (+ id serial primary key+ , firstname text+ , lastname text+ , age integer);|]+ void $ execute_ conn [r|create table if not exists accounts (+ id serial primary key+ , name text+ , description text+ , user_id integer references users(id));|]+ execute_ conn [r|create table if not exists profiles (+ id serial primary key+ , active boolean+ , user_id integer references users(id)+ , account_id integer references accounts(id));|]+
+ test/Quokka/Tables.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}++module Quokka.Tables (+ accountTableAsChild+, insertAccounts+, insertProfiles+, insertUsers+, userTable+) where++import Database.PostgreSQL.Simple (Connection, ToRow)+import Quokka.Types (ChildTable (..), Id (..), ParentTable (..))+import Quokka.Functions (build, buildWith1Rel, buildWithManyRels)+++userTable :: ParentTable+userTable =+ ParentTable "users" ["firstname", "lastname", "age"]+++accountTableAsParent :: ParentTable+accountTableAsParent =+ ParentTable "accounts" ["name", "description"]+++accountTableAsChild :: ChildTable+accountTableAsChild =+ ChildTable "accounts" ["name", "description"]+++profileTable :: ChildTable+profileTable =+ ChildTable "profiles" ["active"]+++insertUsers+ :: (ToRow q)+ => Connection+ -> [q]+ -> IO [Id]+insertUsers conn =+ build conn userTable+++insertAccounts+ :: (ToRow q)+ => Connection+ -> [q]+ -> IO [Id]+insertAccounts conn =+ buildWith1Rel conn userTable accountTableAsChild+++insertProfiles+ :: (ToRow q)+ => Connection+ -> [q]+ -> IO [Id]+insertProfiles conn =+ buildWithManyRels conn [userTable, accountTableAsParent] profileTable
+ test/Spec.hs view
@@ -0,0 +1,12 @@+module Main (+ main+) where++import Test.Hspec++import qualified Quokka.CreateSpec as CreateSpec+++main :: IO ()+main =+ hspec CreateSpec.spec