module IHP.IDE.SchemaDesigner.Controller.Schema where import IHP.ControllerPrelude import IHP.IDE.ToolServer.Types import IHP.IDE.SchemaDesigner.View.Schema.Code import IHP.IDE.SchemaDesigner.View.Schema.GeneratedCode import IHP.IDE.SchemaDesigner.View.Schema.SchemaUpdateFailed import IHP.IDE.SchemaDesigner.Parser import qualified IHP.SchemaCompiler as SchemaCompiler import qualified System.Process as Process import System.Exit import qualified Data.Text as Text import qualified Data.Text.IO as Text import IHP.IDE.SchemaDesigner.Controller.Tables () import IHP.IDE.SchemaDesigner.View.Layout import IHP.IDE.ToolServer.Routes () import IHP.IDE.SchemaDesigner.Controller.Helper instance Controller SchemaController where beforeAction :: (?context::ControllerContext, ?modelContext::ModelContext, ?theAction::SchemaController) => IO () beforeAction = (?context::ControllerContext) => ((?context::ControllerContext) => Layout) -> IO () ((?context::ControllerContext) => Layout) -> IO () setLayout (?context::ControllerContext) => Layout Layout Html -> Html schemaDesignerLayout action :: (?context::ControllerContext, ?modelContext::ModelContext, ?theAction::SchemaController) => SchemaController -> IO () action SchemaController ShowCodeAction = do Text schema <- String -> IO Text Text.readFile String schemaFilePath Maybe ByteString error <- IO (Maybe ByteString) getSqlError CodeView -> IO () forall view. (View view, ?context::ControllerContext) => view -> IO () render CodeView { Maybe ByteString Text schema :: Text error :: Maybe ByteString $sel:schema:CodeView :: Text $sel:error:CodeView :: Maybe ByteString .. } action SchemaController SaveCodeAction = do let schema :: Text schema = ByteString -> Text forall valueType. (?context::ControllerContext, ParamReader valueType) => ByteString -> valueType param ByteString "schemaSql" String -> Text -> IO () Text.writeFile String schemaFilePath Text schema SchemaController -> IO () forall action. (?context::ControllerContext, HasPath action) => action -> IO () redirectTo SchemaController ShowCodeAction action SchemaController PushToDbAction = do (ExitCode exitCode, Text stdOut, Text stdErr) <- String -> IO (ExitCode, Text, Text) shell String "make db" let output :: Text output = Text stdErr Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\n\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text stdOut let isError :: Bool isError = case ExitCode exitCode of ExitCode ExitSuccess -> Text "ERROR:" Text -> Text -> Bool `Text.isInfixOf` Text stdErr ExitFailure Int _ -> Bool True if Bool isError then do SchemaUpdateFailedView -> IO () forall view. (?context::ControllerContext, View view) => view -> IO () setModal SchemaUpdateFailedView { Text ExitCode exitCode :: ExitCode output :: Text $sel:output:SchemaUpdateFailedView :: Text $sel:exitCode:SchemaUpdateFailedView :: ExitCode .. } TablesController -> IO () forall action. (Controller action, ?context::ControllerContext, ?modelContext::ModelContext) => action -> IO () jumpToAction TablesController TablesAction else do (?context::ControllerContext) => Text -> IO () Text -> IO () setSuccessMessage Text "Recreated DB" TablesController -> IO () forall action. (?context::ControllerContext, HasPath action) => action -> IO () redirectTo TablesController TablesAction action SchemaController DumpDbAction = do String -> IO ExitCode Process.system String "make dumpdb" (?context::ControllerContext) => Text -> IO () Text -> IO () setSuccessMessage Text "Database State saved to Application/Fixtures.sql" TablesController -> IO () forall action. (?context::ControllerContext, HasPath action) => action -> IO () redirectTo TablesController TablesAction action SchemaController UpdateDbAction = do String -> IO ExitCode Process.system String "make dumpdb" (ExitCode exitCode, Text stdOut, Text stdErr) <- String -> IO (ExitCode, Text, Text) shell String "make db" let output :: Text output = Text stdErr Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\n\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text stdOut let isError :: Bool isError = case ExitCode exitCode of ExitCode ExitSuccess -> Text "ERROR:" Text -> Text -> Bool `Text.isInfixOf` Text stdErr ExitFailure Int _ -> Bool True if Bool isError then do SchemaUpdateFailedView -> IO () forall view. (?context::ControllerContext, View view) => view -> IO () setModal SchemaUpdateFailedView { Text ExitCode $sel:output:SchemaUpdateFailedView :: Text $sel:exitCode:SchemaUpdateFailedView :: ExitCode exitCode :: ExitCode output :: Text .. } TablesController -> IO () forall action. (Controller action, ?context::ControllerContext, ?modelContext::ModelContext) => action -> IO () jumpToAction TablesController TablesAction else do (?context::ControllerContext) => Text -> IO () Text -> IO () setSuccessMessage Text "DB Update successful" TablesController -> IO () forall action. (?context::ControllerContext, HasPath action) => action -> IO () redirectTo TablesController TablesAction action ShowGeneratedCodeAction { Text statementName :: Text $sel:statementName:PushToDbAction :: SchemaController -> Text statementName } = do [Statement] statements <- IO [Statement] forall controller. (?context::ControllerContext, ?modelContext::ModelContext, ?theAction::controller) => IO [Statement] readSchema let (Just Statement statement) = Text -> [Statement] -> Maybe Statement forall {t :: * -> *}. Foldable t => Text -> t Statement -> Maybe Statement findStatementByName Text statementName [Statement] statements let generatedHaskellCode :: Text generatedHaskellCode = [Statement] -> Statement -> Text SchemaCompiler.compileStatementPreview [Statement] statements Statement statement GeneratedCodeView -> IO () forall view. (View view, ?context::ControllerContext) => view -> IO () render GeneratedCodeView { [Statement] Text statements :: [Statement] generatedHaskellCode :: Text $sel:statements:GeneratedCodeView :: [Statement] $sel:generatedHaskellCode:GeneratedCodeView :: Text .. } shell :: String -> IO (ExitCode, Text, Text) shell :: String -> IO (ExitCode, Text, Text) shell String command = do (ExitCode exitCode, String stdOut, String stdErr) <- CreateProcess -> String -> IO (ExitCode, String, String) Process.readCreateProcessWithExitCode (String -> CreateProcess Process.shell String command) String "" (ExitCode, Text, Text) -> IO (ExitCode, Text, Text) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (ExitCode exitCode, String -> Text forall a b. ConvertibleStrings a b => a -> b cs String stdOut, String -> Text forall a b. ConvertibleStrings a b => a -> b cs String stdErr)