Merge pull request #11 from haskell-works/newhoggy/support-for-create…

…_table-and-create_index-steps

Add support for create_table and create_index steps

db/migration.yaml

@@ -2,49 +2,49 @@ description: This file contains the migration steps for the database schema.
 plan:
   - id: 01J6EWQ9NQRBQA3GT3FTCSRPJN
     description: Create Users table
-    up:
-      - | # sql
-        CREATE TABLE users (name VARCHAR(50));
-
-      - | # sql
-        CREATE INDEX idx_users_name ON users (name);
-
-    down:
-      - | # sql
-        DROP INDEX idx_users_name;
-
-      - | # sql
-        DROP TABLE users;
+    steps:
+      - create_table:
+          name: users
+          columns:
+            - name: name
+              type: VARCHAR(50)
+
+      - create_index:
+          name: idx_users_name
+          table: users
+          columns:
+            - name
 
   - id: 01J6EWQ9NQRBQA3GT3FTCSRPJN
     description: Create Projects table
-    up:
-      - | # sql
-        CREATE TABLE projects (name VARCHAR(50));
+    steps:
+      - up: | # sql
+          CREATE TABLE projects (name VARCHAR(50));
 
-      - | # sql
-        CREATE INDEX idx_projects_name ON projects (name);
+      - down: | # sql
+          DROP TABLE projects;
 
-    down:
-      - | # sql
-        DROP INDEX idx_projects_name;
+      - up: | # sql
+          CREATE INDEX idx_projects_name ON projects (name);
 
-      - | # sql
-        DROP TABLE projects;
+      - down: | # sql
+          DROP INDEX idx_projects_name;
 
   - id: 01J6PQ201YECE9R5XYTVWCRJC1
     description: Populate users table
-    up:
-      - | # sql
-        INSERT INTO users (name) VALUES ('Alice');
-
-      - | # sql
-        SELECT COUNT(name) FROM users;
-
-      - | # sql
-        SELECT table_name
-        FROM information_schema.tables
-        WHERE table_schema = 'public'
-          AND table_type = 'BASE TABLE';
-
-    down: []
+    steps:
+      - up: | # sql
+          INSERT INTO users (name) VALUES ('Alice');
+
+      - up: | # sql
+          SELECT COUNT(name) FROM users;
+
+      - up: | # sql
+          SELECT table_name
+          FROM information_schema.tables
+          WHERE table_schema = 'public'
+            AND table_type = 'BASE TABLE';
+
+      - up: | # sql
+          SELECT schema_name
+          FROM information_schema.schemata;

integration/Test/Data/RdsData/Migration/ConnectionSpec.hs

@@ -78,6 +78,21 @@ tasty_rds_integration_test =
 
         L.sort upTables === ["migration", "projects", "users"]
 
+        -- upIndexResult <-
+        --   ( executeStatement $ mconcat
+        --       [ "SELECT schemaname, indexname, tablename"
+        --       , "  FROM pg_indexes"
+        --       , "  ORDER BY schemaname, tablename, indexname;"
+        --       ]
+        --   )
+        --   & trapFail @AWS.Error
+        --   & trapFail @RdsDataError
+        --   & jotShowDataLog
+
+        -- let upIndexes = upIndexResult ^.. the @"records" . each . each . each . the @"stringValue" . _Just
+
+        -- L.sort upIndexes === []
+
         migrateDown "db/migration.yaml"
           & trapFail @AWS.Error
           & trapFail @IOException

polysemy/Data/RdsData/Polysemy/Migration.hs

@@ -1,9 +1,12 @@
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 
+{- HLINT ignore "Use let" -}
+
 module Data.RdsData.Polysemy.Migration
   ( migrateDown,
     migrateUp,
@@ -14,6 +17,7 @@ import qualified Amazonka.Types                 as AWS
 import qualified Data.Aeson                     as J
 import qualified Data.ByteString.Lazy           as LBS
 import           Data.Generics.Product.Any
+import qualified Data.List                      as L
 import           Data.RdsData.Aws
 import           Data.RdsData.Migration.Types   hiding (id)
 import           Data.RdsData.Polysemy.Core
@@ -42,14 +46,38 @@ migrateDown :: ()
 migrateDown migrationFp = do
   value :: Migration <- readYamlFile migrationFp
 
-  let statements = value ^.. the @"plan" . to reverse . each . the @"down" . each
+  let theSteps = value ^.. the @"plan" . to reverse . each . the @"steps" . _Just . to reverse . each
+
+  forM_ theSteps $ \case
+      StepOfDown downStep -> do
+        info $ "Executing statement: " <> tshow downStep
+
+        let statement = downStep ^. the @"down" . the @1
+
+        response <- executeStatement statement
+
+        info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))
+      StepOfUp _ -> pure ()
+      StepOfCreateTable createTableStatement -> do
+        statement <- pure $ mconcat
+          [ "DROP TABLE " <> createTableStatement ^. the @"createTable" . the @"name"
+          ]
 
-  forM_ statements $ \statement -> do
-    info $ "Executing statement: " <> tshow statement
+        info $ "Executing statement: " <> statement
 
-    response <- executeStatement (statement ^. the @1)
+        response <- executeStatement statement
 
-    info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))
+        info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))
+      StepOfCreateIndex createIndexStatement -> do
+        statement <- pure $ mconcat
+          [ "DROP INDEX " <> createIndexStatement ^. the @"createIndex" . the @"name"
+          ]
+
+        info $ "Executing statement: " <> statement
+
+        response <- executeStatement statement
+
+        info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))
 
 migrateUp :: ()
   => Member (DataLog AwsLogEntry) r
@@ -68,11 +96,47 @@ migrateUp :: ()
 migrateUp migrationFp = do
   value :: Migration <- readYamlFile migrationFp
 
-  let statements = value ^.. the @"plan" . each . the @"up" . each
+  let theSteps = value ^.. the @"plan" . each . the @"steps"  . _Just . each
+
+  forM_ theSteps $ \case
+      StepOfUp upStep -> do
+        info $ "Executing statement: " <> tshow upStep
+
+        let statement = upStep ^. the @"up" . the @1
+
+        response <- executeStatement statement
+
+        info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))
+      StepOfDown _ -> pure ()
+      StepOfCreateTable createTableStatement -> do
+        columnClauses <- pure $
+          createTableStatement ^.. the @"createTable" . the @"columns" . each . to \column ->
+            column ^. the @"name" <> " " <> column ^. the @"type_"
+
+        statement <- pure $ mconcat
+          [ "CREATE TABLE " <> createTableStatement ^. the @"createTable" . the @"name" <> " ("
+          , mconcat $ L.intersperse ", " columnClauses
+          , ");\n"
+          ]
+
+        info $ "Executing create table statement: " <> statement
+
+        response <- executeStatement statement
+
+        info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))
+      StepOfCreateIndex createIndexStatement -> do
+        columnClauses <- pure $
+          createIndexStatement ^.. the @"createIndex" . the @"columns" . each
+
+        statement <- pure $ mconcat
+          [ "CREATE INDEX " <> createIndexStatement ^. the @"createIndex" . the @"name"
+          , " ON " <> createIndexStatement ^. the @"createIndex" . the @"table" <> " ("
+          , mconcat $ L.intersperse ", " columnClauses
+          , ");\n"
+          ]
 
-  forM_ statements $ \statement -> do
-    info $ "Executing statement: " <> tshow statement
+        info $ "Executing  create index statement: " <> statement
 
-    response <- executeStatement (statement ^. the @1)
+        response <- executeStatement statement
 
-    info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))
+        info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))