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)