diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for quokka + +## 0.1.0.0 -- 2019-10-30 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/quokka.cabal b/quokka.cabal new file mode 100644 --- /dev/null +++ b/quokka.cabal @@ -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 diff --git a/src/Quokka/Functions.hs b/src/Quokka/Functions.hs new file mode 100644 --- /dev/null +++ b/src/Quokka/Functions.hs @@ -0,0 +1,228 @@ +-- | +-- Module : Quokka.Functions +-- Copyright : © 2019 Shirren Premaratne +-- License : MIT +-- +-- Maintainer : Shirren Premaratne +-- 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) diff --git a/src/Quokka/Text/Countable.hs b/src/Quokka/Text/Countable.hs new file mode 100644 --- /dev/null +++ b/src/Quokka/Text/Countable.hs @@ -0,0 +1,151 @@ +-- | +-- Module : Text.Countable +-- Copyright : © 2016 Brady Ouren +-- License : MIT +-- +-- Maintainer : Brady Ouren +-- 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 diff --git a/src/Quokka/Text/Data.hs b/src/Quokka/Text/Data.hs new file mode 100644 --- /dev/null +++ b/src/Quokka/Text/Data.hs @@ -0,0 +1,110 @@ +-- | +-- Module : Text.Countable +-- Copyright : © 2016 Brady Ouren +-- License : MIT +-- +-- Maintainer : Brady Ouren +-- 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" + ] diff --git a/src/Quokka/Types.hs b/src/Quokka/Types.hs new file mode 100644 --- /dev/null +++ b/src/Quokka/Types.hs @@ -0,0 +1,68 @@ +-- | +-- Module : Quokka.Types +-- Copyright : © 2019 Shirren Premaratne +-- License : MIT +-- +-- Maintainer : Shirren Premaratne +-- 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 diff --git a/test/Quokka/CreateSpec.hs b/test/Quokka/CreateSpec.hs new file mode 100644 --- /dev/null +++ b/test/Quokka/CreateSpec.hs @@ -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 diff --git a/test/Quokka/Helper.hs b/test/Quokka/Helper.hs new file mode 100644 --- /dev/null +++ b/test/Quokka/Helper.hs @@ -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));|] + diff --git a/test/Quokka/Tables.hs b/test/Quokka/Tables.hs new file mode 100644 --- /dev/null +++ b/test/Quokka/Tables.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,12 @@ +module Main ( + main +) where + +import Test.Hspec + +import qualified Quokka.CreateSpec as CreateSpec + + +main :: IO () +main = + hspec CreateSpec.spec