module IHP.IDE.SchemaDesigner.Controller.Helper where

import IHP.ControllerPrelude
import IHP.IDE.SchemaDesigner.Types
import qualified IHP.IDE.SchemaDesigner.Parser as Parser
import qualified Text.Megaparsec as Megaparsec
import qualified IHP.IDE.SchemaDesigner.Compiler as SchemaCompiler
import IHP.IDE.SchemaDesigner.View.Schema.Error
import IHP.IDE.ToolServer.Helper.Controller

instance ParamReader PostgresType where
    readParameter :: ByteString -> Either ByteString PostgresType
readParameter ByteString
byteString = case Parsec Void Text PostgresType
-> String
-> Text
-> Either (ParseErrorBundle Text Void) PostgresType
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.runParser Parsec Void Text PostgresType
Parser.sqlType String
"" (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
byteString) of
        Left ParseErrorBundle Text Void
error -> ByteString -> Either ByteString PostgresType
forall a b. a -> Either a b
Left (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> Text
forall a. Show a => a -> Text
tshow ParseErrorBundle Text Void
error)
        Right PostgresType
result -> PostgresType -> Either ByteString PostgresType
forall a b. b -> Either a b
Right PostgresType
result

instance ParamReader Expression where
    readParameter :: ByteString -> Either ByteString Expression
readParameter ByteString
byteString = case Parsec Void Text Expression
-> String -> Text -> Either (ParseErrorBundle Text Void) Expression
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.runParser Parsec Void Text Expression
Parser.expression String
"" (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
byteString) of
        Left ParseErrorBundle Text Void
parserError -> ByteString -> Either ByteString Expression
forall a b. a -> Either a b
Left (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty ParseErrorBundle Text Void
parserError)
        Right Expression
result -> Expression -> Either ByteString Expression
forall a b. b -> Either a b
Right Expression
result

instance ParamReader [IndexColumn] where
    readParameter :: ByteString -> Either ByteString [IndexColumn]
readParameter ByteString
byteString = case Parsec Void Text [IndexColumn]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [IndexColumn]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.runParser Parsec Void Text [IndexColumn]
Parser.parseIndexColumns String
"" (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
byteString) of
        Left ParseErrorBundle Text Void
parserError -> ByteString -> Either ByteString [IndexColumn]
forall a b. a -> Either a b
Left (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty ParseErrorBundle Text Void
parserError)
        Right [IndexColumn]
result -> [IndexColumn] -> Either ByteString [IndexColumn]
forall a b. b -> Either a b
Right [IndexColumn]
result

readSchema ::
    ( ?context::ControllerContext
    , ?modelContext::ModelContext
    , ?theAction::controller
    ) => IO [Statement]
readSchema :: forall controller.
(?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::controller) =>
IO [Statement]
readSchema = IO (Either ByteString [Statement])
Parser.parseSchemaSql IO (Either ByteString [Statement])
-> (Either ByteString [Statement] -> IO [Statement])
-> IO [Statement]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ByteString
error -> do ErrorView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render ErrorView { ByteString
error :: ByteString
$sel:error:ErrorView :: ByteString
error }; [Statement] -> IO [Statement]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Right [Statement]
statements -> [Statement] -> IO [Statement]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
statements

getSqlError :: IO (Maybe ByteString)
getSqlError :: IO (Maybe ByteString)
getSqlError = IO (Either ByteString [Statement])
Parser.parseSchemaSql IO (Either ByteString [Statement])
-> (Either ByteString [Statement] -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ByteString
error -> do Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
error)
        Right [Statement]
statements -> do Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing

updateSchema ::
    ( ?context :: ControllerContext
    , ?modelContext::ModelContext
    , ?theAction::controller
    ) => ([Statement] -> [Statement]) -> IO ()
updateSchema :: forall controller.
(?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::controller) =>
([Statement] -> [Statement]) -> IO ()
updateSchema [Statement] -> [Statement]
updateFn = do
    [Statement]
statements <- IO [Statement]
forall controller.
(?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::controller) =>
IO [Statement]
readSchema
    let statements' :: [Statement]
statements' = [Statement] -> [Statement]
updateFn [Statement]
statements
    [Statement] -> IO ()
SchemaCompiler.writeSchema [Statement]
statements'
    IO ()
(?context::ControllerContext) => IO ()
markDatabaseNeedsMigration

getAllObjectNames :: [Statement] -> [Text]
getAllObjectNames :: [Statement] -> [Text]
getAllObjectNames = (Statement -> Maybe Text) -> [Statement] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Statement -> Maybe Text
extractObjectName
    where
        extractObjectName :: Statement -> Maybe Text
extractObjectName (StatementCreateTable CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name }) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
        extractObjectName CreateEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name } = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
        extractObjectName Statement
_                       = Maybe Text
forall a. Maybe a
Nothing