Dump schema given beam

Main.hs

module Main where

import qualified Database.Beam.Backend.SQL as Beam
import qualified Database.Beam.Backend.Types as Beam
import qualified Database.Beam.Migrate as Beam
import qualified Database.Beam.Migrate.Backend as Beam
import qualified Database.Beam.Migrate.Generics as Beam
import qualified Database.Beam.Migrate.Simple as Beam
import           Database.Beam.Postgres.Syntax (PgCommandSyntax, pgRenderSyntaxScript, fromPgCommand, pgBigSerialType)
import qualified Database.Beam.Postgres        as Beam
import qualified Database.Beam.Postgres.Migrate as Beam
import qualified Data.ByteString.Lazy          as BSL
import qualified Data.ByteString.Char8         as BS
import           Data.String                    ( fromString )
import Database.PostgreSQL.Simple 


creationCommands' :: ((Beam.HasDefaultSqlDataType Beam.Postgres (Beam.SqlSerial Int64))) => Maybe [PgCommandSyntax]
creationCommands' = Beam.simpleSchema
  (Beam.backendActionProvider Beam.migrationBackend)
  (Beam.defaultMigratableDbSettings :: Beam.CheckedDatabaseSettings
      Beam.Postgres
      SchemaDB
  )

creationCommands :: ((Beam.HasDefaultSqlDataType Beam.Postgres (Beam.SqlSerial Int64))) => Maybe [Query]
creationCommands =
  fmap
      ( (\l -> fromString $ addscheeeema l <> [';'])
      . BS.unpack
      . BSL.toStrict
      . pgRenderSyntaxScript
      . fromPgCommand
      )
    <$> creationCommands'
  where addscheeeema = replace "CREATE TABLE \"" "CREATE TABLE scheeeema.\""


-- dumpSchema :: ((Beam.HasDefaultSqlDataType Beam.Postgres (Beam.SqlSerial Int64))) => IO ()
-- dumpSchema = do 
--   let (Just f) = fmap (writeFile "scheeeema.sql" . unlines) (fmap (fmap coerce) creationCommands)
--   _ <- f 
--   pure ()

replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace needle replacement haystack = case begins haystack needle of
  Just remains -> replacement <> remains
  Nothing      -> case haystack of
    []     -> []
    x : xs -> x : replace needle replacement xs

begins :: Eq a => [a] -> [a] -> Maybe [a]
begins haystack []                = Just haystack
begins (x : xs) (y : ys) | x == y = begins xs ys
begins _ _                        = Nothing

instance Beam.HasDefaultSqlDataType Beam.Postgres (Beam.SqlSerial Int64) where
    defaultSqlDataType _ _ False = pgBigSerialType
    defaultSqlDataType _ _ _     = Beam.bigIntType