wasp/waspc/e2e-test/ShellCommands.hs
2022-12-13 13:55:01 -05:00

114 lines
4.6 KiB
Haskell

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module ShellCommands
( ShellCommand,
ShellCommandContext (..),
ShellCommandBuilder (..),
runShellCommandBuilder,
combineShellCommands,
cdIntoCurrentProject,
appendToWaspFile,
createFile,
setDbToPSQL,
waspCliNew,
waspCliCompile,
waspCliMigrate,
waspCliBuild,
dockerBuild,
)
where
import Control.Monad.Reader (MonadReader (ask), Reader, runReader)
import Data.List (intercalate)
import System.FilePath (joinPath, (</>))
-- NOTE: Should we consider separating shell parts, Wasp CLI parts, and test helper parts in the future?
-- This would likely reqiure adoption of some library, and creating new layers of abstraction.
-- Deemed not worth it right now by all.
-- NOTE: Using `wasp-cli` herein so we can assume using latest `stack install` in CI and locally.
-- TODO: In future, find a good way to test `wasp-cli start`.
type ShellCommand = String
-- Each shell command gets access to the current project name, and maybe other things in future.
data ShellCommandContext = ShellCommandContext
{ _ctxtCurrentProjectName :: String
}
deriving (Show)
-- Used to construct shell commands, while still giving access to the context (if needed).
newtype ShellCommandBuilder a = ShellCommandBuilder {_runShellCommandBuilder :: Reader ShellCommandContext a}
deriving (Functor, Applicative, Monad, MonadReader ShellCommandContext)
runShellCommandBuilder :: ShellCommandBuilder a -> ShellCommandContext -> a
runShellCommandBuilder shellCommandBuilder context =
runReader (_runShellCommandBuilder shellCommandBuilder) context
combineShellCommands :: [ShellCommand] -> ShellCommand
combineShellCommands = intercalate " && "
cdIntoCurrentProject :: ShellCommandBuilder ShellCommand
cdIntoCurrentProject = do
context <- ask
return $ "cd " ++ _ctxtCurrentProjectName context
appendToWaspFile :: String -> ShellCommandBuilder ShellCommand
appendToWaspFile content =
-- NOTE: Using `show` to preserve newlines in string.
return $ "printf " ++ show (content ++ "\n") ++ " >> main.wasp"
-- NOTE: Pretty fragile. Can't handle spaces in args, *nix only, etc.
createFile :: String -> FilePath -> String -> ShellCommandBuilder ShellCommand
createFile content relDirFp filename = return $ combineShellCommands [createParentDir, writeContentsToFile]
where
createParentDir = "mkdir -p ./" ++ relDirFp
destinationFile = "./" ++ relDirFp ++ "/" ++ filename
contents = show (content ++ "\n")
writeContentsToFile = unwords ["printf", contents, ">", destinationFile]
-- NOTE: This is fragile and will likely break in future. Assumes `app` decl is first line and by default
-- we do not have a `db` field. Consider better alternatives.
setDbToPSQL :: ShellCommandBuilder ShellCommand
setDbToPSQL =
return $
combineShellCommands
[ -- Change DB to postgres by adding string at specific line so it still parses.
"awk 'NR==2{print \" db: { system: PostgreSQL },\"}1' main.wasp > main.wasp.tmp",
"mv main.wasp.tmp main.wasp"
]
waspCliNew :: ShellCommandBuilder ShellCommand
waspCliNew = do
context <- ask
return $ "wasp-cli new " ++ _ctxtCurrentProjectName context
waspCliCompile :: ShellCommandBuilder ShellCommand
waspCliCompile = return "wasp-cli compile"
-- TODO: We need to be careful what migration names we accept here, as Prisma will
-- normalize a migration name containing spaces/dashes to underscores (and maybe other rules).
-- This will impact our ability to move directories around if the names do not match exactly.
-- Put in some check eventually.
waspCliMigrate :: String -> ShellCommandBuilder ShellCommand
waspCliMigrate migrationName =
let generatedMigrationsDir = joinPath [".wasp", "out", "db", "migrations"]
waspMigrationsDir = "migrations"
in return $
combineShellCommands
[ -- Migrate using a migration name to avoid Prisma asking via CLI.
"wasp-cli db migrate-dev --name " ++ migrationName,
-- Rename both migrations to remove the date-specific portion of the directory to something static.
"mv " ++ (waspMigrationsDir </> ("*" ++ migrationName)) ++ " " ++ (waspMigrationsDir </> ("no-date-" ++ migrationName)),
"mv " ++ (generatedMigrationsDir </> ("*" ++ migrationName)) ++ " " ++ (generatedMigrationsDir </> ("no-date-" ++ migrationName))
]
waspCliBuild :: ShellCommandBuilder ShellCommand
waspCliBuild = return "wasp-cli build"
dockerBuild :: ShellCommandBuilder ShellCommand
dockerBuild =
return
"[ -z \"$WASP_E2E_TESTS_SKIP_DOCKER\" ] && cd .wasp/build && docker build . && cd ../.. || true"