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