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 IHP.IDE.SchemaDesigner.Parser (schemaFilePath)
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 :: IO ()
beforeAction = (?context::ControllerContext) =>
((?context::ControllerContext) => Layout) -> IO ()
((?context::ControllerContext) => Layout) -> IO ()
setLayout (?context::ControllerContext) => Layout
Html -> Html
schemaDesignerLayout

    action :: SchemaController -> IO ()
action SchemaController
ShowCodeAction = do
        Text
schema <- FilePath -> IO Text
Text.readFile FilePath
schemaFilePath
        Maybe ByteString
error <- IO (Maybe ByteString)
getSqlError
        CodeView -> IO ()
forall view controller.
(View view, ?theAction::controller, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
view -> IO ()
render CodeView :: Text -> Maybe ByteString -> CodeView
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 = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"schemaSql"
        FilePath -> Text -> IO ()
Text.writeFile FilePath
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) <- FilePath -> IO (ExitCode, Text, Text)
shell FilePath
"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 -> SchemaUpdateFailedView
SchemaUpdateFailedView { Text
ExitCode
$sel:exitCode:SchemaUpdateFailedView :: ExitCode
$sel:output:SchemaUpdateFailedView :: Text
output :: Text
exitCode :: 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
        FilePath -> IO ExitCode
Process.system FilePath
"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
        FilePath -> IO ExitCode
Process.system FilePath
"make dumpdb"

        (ExitCode
exitCode, Text
stdOut, Text
stdErr) <- FilePath -> IO (ExitCode, Text, Text)
shell FilePath
"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 -> SchemaUpdateFailedView
SchemaUpdateFailedView { Text
ExitCode
output :: Text
exitCode :: ExitCode
$sel:exitCode:SchemaUpdateFailedView :: ExitCode
$sel:output:SchemaUpdateFailedView :: 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
$sel:statementName:PushToDbAction :: SchemaController -> Text
statementName :: 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 controller.
(View view, ?theAction::controller, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
view -> IO ()
render GeneratedCodeView :: [Statement] -> Text -> GeneratedCodeView
GeneratedCodeView { [Statement]
Text
$sel:generatedHaskellCode:GeneratedCodeView :: Text
$sel:statements:GeneratedCodeView :: [Statement]
generatedHaskellCode :: Text
statements :: [Statement]
.. }

shell :: String -> IO (ExitCode, Text, Text)
shell :: FilePath -> IO (ExitCode, Text, Text)
shell FilePath
command = do
    (ExitCode
exitCode, FilePath
stdOut, FilePath
stdErr) <- CreateProcess -> FilePath -> IO (ExitCode, FilePath, FilePath)
Process.readCreateProcessWithExitCode (FilePath -> CreateProcess
Process.shell FilePath
command) FilePath
""
    (ExitCode, Text, Text) -> IO (ExitCode, Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode
exitCode, FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs FilePath
stdOut, FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs FilePath
stdErr)