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.Error
import IHP.IDE.SchemaDesigner.View.Schema.GeneratedCode
import IHP.IDE.SchemaDesigner.View.Schema.SchemaUpdateFailed

import IHP.IDE.SchemaDesigner.Parser
import IHP.IDE.SchemaDesigner.Compiler
import IHP.IDE.SchemaDesigner.Types
import IHP.IDE.SchemaDesigner.View.Layout (findStatementByName, findStatementByName, removeQuotes, replace)
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.View.Layout
import IHP.IDE.SchemaDesigner.Controller.Tables
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 ()
setLayout 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
        forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render CodeView { Maybe ByteString
Text
$sel:error:CodeView :: Maybe ByteString
$sel:schema:CodeView :: Text
error :: Maybe ByteString
schema :: Text
.. }

    action SchemaController
SaveCodeAction = do
        let schema :: Text
schema = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"schemaSql"
        String -> Text -> IO ()
Text.writeFile String
schemaFilePath Text
schema
        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 forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" 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
                forall view.
(?context::ControllerContext, View view) =>
view -> IO ()
setModal SchemaUpdateFailedView { Text
ExitCode
$sel:exitCode:SchemaUpdateFailedView :: ExitCode
$sel:output:SchemaUpdateFailedView :: Text
output :: Text
exitCode :: ExitCode
.. }
                forall action.
(Controller action, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
action -> IO ()
jumpToAction TablesController
TablesAction
            else do
                (?context::ControllerContext) => Text -> IO ()
setSuccessMessage Text
"Recreated DB"
                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 ()
setSuccessMessage Text
"Database State saved to Application/Fixtures.sql"
        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 forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" 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
                forall view.
(?context::ControllerContext, View view) =>
view -> IO ()
setModal SchemaUpdateFailedView { Text
ExitCode
output :: Text
exitCode :: ExitCode
$sel:exitCode:SchemaUpdateFailedView :: ExitCode
$sel:output:SchemaUpdateFailedView :: Text
.. }
                forall action.
(Controller action, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
action -> IO ()
jumpToAction TablesController
TablesAction
            else do
                (?context::ControllerContext) => Text -> IO ()
setSuccessMessage Text
"DB Update successful"
                forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo TablesController
TablesAction

    action ShowGeneratedCodeAction { Text
$sel:statementName:PushToDbAction :: SchemaController -> Text
statementName :: Text
statementName } = do
        [Statement]
statements <- forall controller.
(?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::controller) =>
IO [Statement]
readSchema
        let (Just Statement
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
        forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render GeneratedCodeView { [Statement]
Text
$sel:generatedHaskellCode:GeneratedCodeView :: Text
$sel:statements:GeneratedCodeView :: [Statement]
generatedHaskellCode :: Text
statements :: [Statement]
.. }

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
""
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode
exitCode, forall a b. ConvertibleStrings a b => a -> b
cs String
stdOut, forall a b. ConvertibleStrings a b => a -> b
cs String
stdErr)