1601 default vals

IHP/IDE/Defaults/TableColumnDefaults.hs

@@ -0,0 +1,232 @@
+{-|
+Module: Test.IDE.Defaults.TableColumnDefaults
+Copyright: (c) digitally induced GmbH, 2020
+-}
+module IHP.IDE.Defaults.TableColumnDefaults where
+
+import Test.Hspec
+import IHP.Prelude
+import qualified IHP.IDE.CodeGen.ControllerGenerator as ControllerGenerator
+import IHP.ViewPrelude (cs, plain)
+import qualified Text.Megaparsec as Megaparsec
+import IHP.IDE.CodeGen.Types
+import IHP.IDE.SchemaDesigner.Types
+import IHP.NameSupport
+import IHP.IDE.SchemaDesigner.Types
+
+
+{- | Takes a 'Text' value for the name and creates a default column where all values are empty lists, 
+'Nothing' or 'False'; and for 'ColumnType', the default is 'PUUID'.
+
+Add a new field to the 'Column' type in the 
+"IHP.IDE.SchemaDesigner.Types" file and then 
+set its default value here
+
+Defined as:
+
+@
+defColumn :: Column
+defColumn = Column { 
+                 name = ""
+               , columnType = PUUID 
+               , defaultValue = Nothing
+               , notNull = False 
+               , isUnique = False
+               , generator = Nothing
+               }
+@
+
+If you want a different 'PostgresType' you will need to 
+specify with like so by either using a function:
+
+@setColumnType pgt = defColumn {columnType = pgt}@
+
+Or
+
+Just as part of where you're calling it:
+
+@someDefaultColumnType = defColumn {columnType = PDate}@
+-}
+defColumn :: Column
+defColumn = 
+      Column 
+      { name = ""
+      , columnType = PUUID 
+      , defaultValue = Nothing
+      , notNull = False 
+      , isUnique = False
+      , generator = Nothing
+      }
+
+
+{- | Creates an empty table with all values empty. @unlogged@ is set to 'False'.
+
+Defined as such:
+
+@
+emptyTable :: CreateTable
+emptyTable = CreateTable {
+                        name = ""
+                        , columns = []
+                        , primaryKeyConstraint = PrimaryKeyConstraint []
+                        , constraints = []
+                        , unlogged = False
+                        }
+@
+
+-}
+emptyTable :: CreateTable
+emptyTable = CreateTable 
+                  { name = ""
+                  , columns = []
+                  , primaryKeyConstraint = PrimaryKeyConstraint []
+                  , constraints = []
+                  , unlogged = False
+                  }
+
+-- | Takes a name for our table and a list of column and inserts the list
+--   into to our empty table.
+defCreateTable :: Text -> [Column] -> CreateTable
+defCreateTable tablename columns = emptyTable { name = tablename
+                                              , columns = columns }
+
+
+
+
+{- | Creates one default table with a singleton list of one 'setColumn'.
+
+Uses both `defCreateTable` and `setColumn`.
+
+@
+defCreateTableWSetCol :: Text --  The name of the table
+                        -> Text  --  The name of the column
+                        -> PostgresType --  The type of the column
+                        -> CreateTable -- The returned table
+@
+
+-}
+defCreateTableWSetCol :: Text -> Text -> PostgresType -> CreateTable
+defCreateTableWSetCol tablename columnname pgt = defCreateTable tablename (pure $ setColumn columnname pgt)
+
+{- | Same as its progenitor `defCreateTableWSetCol` except it uses `setColumnN`
+-}
+defCreateTableWSetColN :: Text -> Text -> PostgresType -> CreateTable
+defCreateTableWSetColN tablename columnname pgt = defCreateTable tablename (pure $ setColumnN columnname pgt)
+
+
+{- | Takes the name of the table, the items you want inside the primaryKeyConstraint and a list of columns
+to return a table where the primary key constraint is set.
+
+__Example:__ 
+
+@ 
+let orderTrucksTable = defCreateTablePKID "orderTrucks" ["order_id","truck_id"] cols
+                  where cols = map mkColumn ["order_id","truck_id"]
+                        mkColumn x = (setColumnN x PBigserial)
+@
+
+>>> orderTrucksTable
+CreateTable { name = "orderTrucks"
+            , columns = [ Column { name = "order_id", 
+                                   columnType = PBigserial, 
+                                   defaultValue = Nothing, 
+                                   notNull = True, 
+                                   isUnique = False, 
+                                   generator = Nothing}
+                        , Column { name = "truck_id", 
+                                   columnType = PBigserial, 
+                                   defaultValue = Nothing, 
+                                   notNull = True, 
+                                   isUnique = False, 
+                                   generator = Nothing}
+                         ]
+            , primaryKeyConstraint = PrimaryKeyConstraint {primaryKeyColumnNames = ["order_id","truck_id"]}
+            , constraints = []
+            , unlogged = False}
+-}
+defCreateTablePKID :: Text -> [Text] -> [Column] -> CreateTable
+defCreateTablePKID name items cols = (defCreateTable name cols) {primaryKeyConstraint = PrimaryKeyConstraint items}
+
+
+{- | Allows you to set the name and columnType. Uses `defColumn` as its base
+
+If other values need to be changed, this can be done using: 
+@(setColumn a b){..}@
+
+__Example:__
+
+>>> setColumn "user_id" PTrigger 
+Column {name = "user_id", columnType = PTrigger, defaultValue = Nothing, notNull = False, isUnique = False, generator = Nothing}
+
+-}
+setColumn :: Text -> PostgresType -> Column
+setColumn name pgt = defColumn { name = name
+                               , columnType = pgt
+                               }
+
+-- | A version of `setColumn` where @notNull = True@
+setColumnN :: Text -> PostgresType -> Column
+setColumnN n p = (setColumn n p) {notNull = True}
+
+-- | Sets a column to have a default value. Would recommend using in conjunction with `setColumn`
+setColumnDefaultVal :: Maybe Expression -> Column -> Column
+setColumnDefaultVal expression column = column {defaultValue = expression}
+
+
+{- | A recurring unit as found in many tests and files.
+
+Defined as such:
+
+>>> colUUID
+Column {name = "id", columnType = PUUID, defaultValue = Just (CallExpression "uuid_generate_v4" []), notNull = True, isUnique = False, generator = Nothing}
+
+-}
+colUUID :: Column
+colUUID = setColumnDefaultVal (Just (CallExpression "uuid_generate_v4" [])) $ setColumnN "id" PUUID
+
+{- | Give a column the text defined by 'text' and sets its 'columnType' to 'PText'. Uses `setColumnN`.
+
+__Example:__
+
+>>> colText "example"
+Column {name = "example", columnType = PText, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing}
+
+-}
+colText :: Text -> Column
+colText text = setColumnN text PText
+
+
+{- | A recurring table that appears in many tests.
+
+This is its current definition:
+
+@
+compilerSpecTable :: CreateTable
+compilerSpecTable = defCreateTablePKID "users" ["id"] cols
+
+                  where cols = [ colUUID
+                               , colText "firstname"
+                               , colText "lastname"
+                               , colText  "password_hash"
+                               , colText "email"
+                               , setColumnN "company_id" PUUID
+                               , setColumn "picture_url" PText
+                               , setColumnDefaultVal (Just (CallExpression "NOW" [])) $ setColumnN "created_at" PTimestampWithTimezone
+                               ]
+@
+-}
+compilerSpecTable :: CreateTable
+compilerSpecTable = defCreateTablePKID "users" ["id"] cols
+
+                  where cols = [ colUUID
+                               , colText "firstname"
+                               , colText "lastname"
+                               , colText  "password_hash"
+                               , colText "email"
+                               , setColumnN "company_id" PUUID
+                               , setColumn "picture_url" PText
+                               , setColumnDefaultVal (Just (CallExpression "NOW" [])) $ setColumnN "created_at" PTimestampWithTimezone
+                               ]
+
+
+

IHP/IDE/SchemaDesigner/SchemaOperations.hs

@@ -10,28 +10,14 @@ import IHP.IDE.SchemaDesigner.Types
 import Data.Maybe (fromJust)
 import qualified Data.List as List
 import qualified Data.Text as Text
+import IHP.IDE.Defaults.TableColumnDefaults
 
 -- | A Schema.sql basically is just a list of sql DDL statements
 type Schema = [Statement]
 
 -- | Creates a new tables with a 'id' columns as the primary key
 addTable :: Text -> Schema -> Schema
-addTable tableName list = list <> [StatementCreateTable CreateTable
-    { name = tableName
-    , columns =
-        [Column
-            { name = "id"
-            , columnType = PUUID
-            , defaultValue = Just (CallExpression "uuid_generate_v4" [])
-            , notNull = True
-            , isUnique = False
-            , generator = Nothing
-            }]
-    , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
-    , constraints = []
-    , unlogged = False
-    }]
-
+addTable tableName list = list <> [StatementCreateTable (defCreateTablePKID tableName ["id"] [colUUID])]
 
 data AddColumnOptions = AddColumnOptions
     { tableName :: !Text

IHP/PGListener.hs

@@ -37,7 +37,6 @@ import qualified Data.Aeson as Aeson
 import qualified IHP.Log as Log
 import qualified Control.Exception as Exception
 import qualified Control.Concurrent.Chan.Unagi as Queue
-import qualified Control.Concurrent
 
 -- TODO: How to deal with timeout of the connection?
 
@@ -232,38 +231,18 @@ notifyLoop listeningToVar listenToVar subscriptions = do
                             let inChan = get #inChan subscription
                             Queue.writeChan inChan notification
 
-    -- Initial delay (in microseconds)
-    let initialDelay = 500 * 1000
-    -- Max delay (in microseconds)
-    let maxDelay = 60 * 1000 * 1000
     -- This outer loop restarts the listeners if the database connection dies (e.g. due to a timeout)
-    let retryLoop delay isFirstError = do
-            result <- Exception.try innerLoop
-            case result of
-                Left (error :: SomeException) -> do
-                    case fromException error of
-                        Just (error :: AsyncCancelled) -> throw error
-                        notification -> do
-                            let ?context = ?modelContext -- Log onto the modelContext logger
-                            if isFirstError then do
-                                Log.info ("PGListener is going to restart, loop failed with exception: " <> (displayException error) <> ". Retrying immediately.")
-                                retryLoop delay False -- Retry with no delay interval on first error, but will increase delay interval in subsequent retries 
-                            else do
-                                let increasedDelay = delay * 2 -- Double current delay
-                                let nextDelay = min increasedDelay maxDelay -- Picks whichever delay is lowest of increasedDelay * 2 or maxDelay
-                                Log.info ("PGListener is going to restart, loop failed with exception: " <> (displayException error) <> ". Retrying in " <> cs (printTimeToNextRetry delay) <> ".")
-                                Control.Concurrent.threadDelay delay -- Sleep for the current delay
-                                retryLoop nextDelay False -- Retry with longer interval
-                Right _ -> 
-                    retryLoop initialDelay True -- If all went well, re-run with no sleeping and reset current delay to the initial value
-    retryLoop initialDelay True
-
-printTimeToNextRetry :: Int -> Text
-printTimeToNextRetry microseconds
-    | microseconds >= 1000000000 =  show (microseconds `div` 1000000000) <> " min"
-    | microseconds >= 1000000 =  show (microseconds `div` 1000000) <> " s"
-    | microseconds >= 1000 = show (microseconds `div` 1000) <> " ms"
-    | otherwise = show microseconds <> " µs"
+    forever do
+        result <- Exception.try innerLoop
+        case result of
+            Left (error :: SomeException) -> do
+                case fromException error of
+                    Just (error :: AsyncCancelled) -> throw error
+                    notification -> do
+                        let ?context = ?modelContext -- Log onto the modelContext logger
+                        Log.info ("PGListener is going to restart, loop failed with exception: " <> displayException error)
+            Right _ -> pure ()
+
 
 listenToChannel :: PG.Connection -> Channel -> IO ()
 listenToChannel databaseConnection channel = do

Test/IDE/CodeGeneration/ControllerGenerator.hs

@@ -12,61 +12,14 @@ import qualified Text.Megaparsec as Megaparsec
 import IHP.IDE.CodeGen.Types
 import IHP.IDE.SchemaDesigner.Types
 import IHP.NameSupport
+import IHP.IDE.Defaults.TableColumnDefaults
 
 tests = do
     describe "Controller Generator Tests:" do
         let schema = [
-                    StatementCreateTable CreateTable {
-                        name = "pages"
-                        , columns = [
-                            Column
-                                { name = "id"
-                                , columnType = PUUID
-                                , defaultValue = Just (CallExpression "uuid_generate_v4" [])
-                                , notNull = True
-                                , isUnique = False
-                                , generator = Nothing
-                                }
-                        ]
-                        , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
-                        , constraints = []
-                        , unlogged = False
-                    },
-                    StatementCreateTable CreateTable {
-                        name = "people"
-                        , columns = [
-                            Column
-                                { name = "id"
-                                , columnType = PUUID
-                                , defaultValue = Just (CallExpression "uuid_generate_v4" [])
-                                , notNull = True
-                                , isUnique = False
-                                , generator = Nothing
-                                }
-                                ,
-                            Column
-                                { name = "name"
-                                , columnType = PText
-                                , defaultValue = Nothing
-                                , notNull = True
-                                , isUnique = False
-                                , generator = Nothing
-                                }
-                                ,
-                            Column
-                                { name = "email"
-                                , columnType = PText
-                                , defaultValue = Nothing
-                                , notNull = True
-                                , isUnique = False
-                                , generator = Nothing
-                                }
-                        ]
-                        , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
-                        , constraints = []
-                        , unlogged = False
-                    }
-                ]
+                    StatementCreateTable (defCreateTablePKID "pages" ["id"] [colUUID])
+                  , StatementCreateTable (defCreateTablePKID "people" ["id"] [colUUID, colText "name" , colText "email"]) 
+                  ]
         it "should build a controller with name \"pages\"" do
             let rawControllerName = "pages"
             let controllerName = tableNameToControllerName rawControllerName