-
Notifications
You must be signed in to change notification settings - Fork 200
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #572 from digitallyinduced/background-jobs
Added IHP.Job
- Loading branch information
Showing
18 changed files
with
645 additions
and
46 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,79 @@ | ||
module IHP.IDE.CodeGen.JobGenerator (buildPlan, buildPlan', JobConfig (..)) where | ||
|
||
import IHP.Prelude | ||
import IHP.HaskellSupport | ||
import qualified Data.Text as Text | ||
import qualified Data.Text.IO as Text | ||
import IHP.ViewSupport | ||
import qualified System.Process as Process | ||
import IHP.IDE.CodeGen.Types | ||
import qualified IHP.IDE.SchemaDesigner.Parser as SchemaDesigner | ||
import IHP.IDE.SchemaDesigner.Types | ||
import qualified Text.Countable as Countable | ||
|
||
data JobConfig = JobConfig | ||
{ applicationName :: Text | ||
, tableName :: Text -- E.g. create_container_jobs | ||
, modelName :: Text -- E.g. CreateContainerJob | ||
} deriving (Eq, Show) | ||
|
||
buildPlan :: Text -> Text -> IO (Either Text [GeneratorAction]) | ||
buildPlan jobName applicationName = | ||
if null jobName | ||
then pure $ Left "Job name can be empty" | ||
else do | ||
let jobConfig = JobConfig | ||
{ applicationName | ||
, tableName = jobName | ||
, modelName = tableNameToModelName jobName | ||
} | ||
pure $ Right $ buildPlan' jobConfig | ||
|
||
-- E.g. qualifiedMailModuleName config "Confirmation" == "Web.Mail.Users.Confirmation" | ||
qualifiedJobModuleName :: JobConfig -> Text | ||
qualifiedJobModuleName config = | ||
get #applicationName config <> ".Job." <> unqualifiedJobModuleName config | ||
|
||
unqualifiedJobModuleName :: JobConfig -> Text | ||
unqualifiedJobModuleName config = Text.replace "Job" "" (get #modelName config) | ||
|
||
buildPlan' :: JobConfig -> [GeneratorAction] | ||
buildPlan' config = | ||
let | ||
name = get #modelName config | ||
tableName = modelNameToTableName name | ||
nameWithSuffix = if "Job" `isSuffixOf` name | ||
then name | ||
else name <> "Job" --e.g. "Test" -> "TestJob" | ||
nameWithoutSuffix = if "Job" `isSuffixOf` name | ||
then Text.replace "Job" "" name | ||
else name --e.g. "TestJob" -> "Test"" | ||
|
||
job = | ||
"" | ||
<> "module " <> qualifiedJobModuleName config <> " where\n" | ||
<> "import " <> get #applicationName config <> ".Controller.Prelude\n" | ||
<> "\n" | ||
<> "instance Job " <> nameWithSuffix <> " where\n" | ||
<> " perform " <> name <> " { .. } = do\n" | ||
<> " putStrLn \"Hello World!\"\n" | ||
|
||
schemaSql = | ||
"" | ||
<> "CREATE TABLE " <> tableName <> " (\n" | ||
<> " id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,\n" | ||
<> " created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,\n" | ||
<> " updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,\n" | ||
<> " status JOB_STATUS DEFAULT 'job_status_not_started' NOT NULL,\n" | ||
<> " last_error TEXT DEFAULT NULL,\n" | ||
<> " attempts_count INT DEFAULT 0 NOT NULL,\n" | ||
<> " locked_at TIMESTAMP WITH TIME ZONE DEFAULT NULL,\n" | ||
<> " locked_by UUID DEFAULT NULL\n" | ||
<> ");\n" | ||
in | ||
[ EnsureDirectory { directory = get #applicationName config <> "/Job" } | ||
, CreateFile { filePath = get #applicationName config <> "/Job/" <> nameWithoutSuffix <> ".hs", fileContent = job } | ||
, AppendToFile { filePath = "Application/Schema.sql", fileContent = schemaSql } | ||
, AppendToMarker { marker = "-- Job Imports", filePath = get #applicationName config <> "/Worker.hs", fileContent = ("import " <> qualifiedJobModuleName config) } | ||
--, AddImport { filePath = get #applicationName config <> "/Controller/" <> controllerName <> ".hs", fileContent = "import " <> qualifiedViewModuleName config nameWithoutSuffix } | ||
] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,65 @@ | ||
module IHP.IDE.CodeGen.View.NewJob where | ||
|
||
import IHP.ViewPrelude | ||
import IHP.IDE.SchemaDesigner.Types | ||
import IHP.IDE.ToolServer.Types | ||
import IHP.IDE.ToolServer.Layout | ||
import IHP.IDE.SchemaDesigner.View.Layout | ||
import IHP.IDE.CodeGen.Types | ||
import IHP.IDE.CodeGen.View.Generators (renderPlan) | ||
import qualified Data.Text as Text | ||
import qualified Data.Text.IO as Text | ||
|
||
data NewJobView = NewJobView | ||
{ plan :: Either Text [GeneratorAction] | ||
, jobName :: Text | ||
, applicationName :: Text | ||
, applications :: [Text] | ||
} | ||
|
||
instance View NewJobView where | ||
html NewJobView { .. } = [hsx| | ||
<div class="generators"> | ||
{renderFlashMessages} | ||
<div class="container pt-5"> | ||
<div class="code-generator new-script"> | ||
{if isEmpty jobName then renderEmpty else renderPreview} | ||
{unless (isEmpty jobName) (renderPlan plan)} | ||
</div> | ||
</div> | ||
</div> | ||
|] | ||
where | ||
renderEmpty = [hsx| | ||
<form method="POST" action={NewJobAction} class="d-flex"> | ||
{when (length applications /= 1) renderApplicationSelector} | ||
<input | ||
type="text" | ||
name="name" | ||
placeholder="Job name" | ||
class="form-control" | ||
autofocus="autofocus" | ||
value={jobName} | ||
/> | ||
<button class="btn btn-primary" type="submit">Preview</button> | ||
</form> | ||
|] | ||
renderApplicationOptions = forM_ applications (\x -> [hsx|<option selected={x == applicationName}>{x}</option>|]) | ||
renderApplicationSelector = [hsx| | ||
<select | ||
name="applicationName" | ||
class="form-control select2-simple" | ||
size="1" | ||
> | ||
{renderApplicationOptions} | ||
</select>|] | ||
renderPreview = [hsx| | ||
<form method="POST" action={CreateMailAction} class="d-flex"> | ||
<div class="object-name flex-grow-1">{applicationName}.Job.{jobName}</div> | ||
|
||
<input type="hidden" name="name" value={jobName}/> | ||
<input type="hidden" name="applicationName" value={applicationName}/> | ||
|
||
<button class="btn btn-primary" type="submit">Generate</button> | ||
</form> | ||
|] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.