module IHP.IDE.CodeGen.ViewGenerator (buildPlan, buildPlan', ViewConfig (..)) where

import IHP.Prelude
import qualified Data.Text as Text
import IHP.IDE.CodeGen.Types
import qualified IHP.IDE.SchemaDesigner.Parser as SchemaDesigner
import IHP.IDE.SchemaDesigner.Types

data ViewConfig = ViewConfig
    { ViewConfig -> Text
controllerName :: Text
    , ViewConfig -> Text
applicationName :: Text
    , ViewConfig -> Text
modelName :: Text
    , ViewConfig -> Text
viewName :: Text
    , ViewConfig -> Bool
paginationEnabled :: Bool
    } deriving (ViewConfig -> ViewConfig -> Bool
(ViewConfig -> ViewConfig -> Bool)
-> (ViewConfig -> ViewConfig -> Bool) -> Eq ViewConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ViewConfig -> ViewConfig -> Bool
== :: ViewConfig -> ViewConfig -> Bool
$c/= :: ViewConfig -> ViewConfig -> Bool
/= :: ViewConfig -> ViewConfig -> Bool
Eq, Int -> ViewConfig -> ShowS
[ViewConfig] -> ShowS
ViewConfig -> String
(Int -> ViewConfig -> ShowS)
-> (ViewConfig -> String)
-> ([ViewConfig] -> ShowS)
-> Show ViewConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ViewConfig -> ShowS
showsPrec :: Int -> ViewConfig -> ShowS
$cshow :: ViewConfig -> String
show :: ViewConfig -> String
$cshowList :: [ViewConfig] -> ShowS
showList :: [ViewConfig] -> ShowS
Show)

buildPlan :: Text -> Text -> Text -> IO (Either Text [GeneratorAction])
buildPlan :: Text -> Text -> Text -> IO (Either Text [GeneratorAction])
buildPlan Text
viewName Text
applicationName Text
controllerName' =
    if (Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
viewName Bool -> Bool -> Bool
|| Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
controllerName')
        then Either Text [GeneratorAction] -> IO (Either Text [GeneratorAction])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [GeneratorAction]
 -> IO (Either Text [GeneratorAction]))
-> Either Text [GeneratorAction]
-> IO (Either Text [GeneratorAction])
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [GeneratorAction]
forall a b. a -> Either a b
Left Text
"Neither view name nor controller name can be empty"
        else do
            [Statement]
schema <- IO (Either ByteString [Statement])
SchemaDesigner.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
parserError -> [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
            let modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
controllerName'
            let controllerName :: Text
controllerName = Text -> Text
tableNameToControllerName Text
controllerName'
            let paginationEnabled :: Bool
paginationEnabled = Bool
False
            let viewConfig :: ViewConfig
viewConfig = ViewConfig { Bool
Text
$sel:controllerName:ViewConfig :: Text
$sel:applicationName:ViewConfig :: Text
$sel:modelName:ViewConfig :: Text
$sel:viewName:ViewConfig :: Text
$sel:paginationEnabled:ViewConfig :: Bool
viewName :: Text
applicationName :: Text
modelName :: Text
controllerName :: Text
paginationEnabled :: Bool
.. }
            Either Text [GeneratorAction] -> IO (Either Text [GeneratorAction])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [GeneratorAction]
 -> IO (Either Text [GeneratorAction]))
-> Either Text [GeneratorAction]
-> IO (Either Text [GeneratorAction])
forall a b. (a -> b) -> a -> b
$ [GeneratorAction] -> Either Text [GeneratorAction]
forall a b. b -> Either a b
Right ([GeneratorAction] -> Either Text [GeneratorAction])
-> [GeneratorAction] -> Either Text [GeneratorAction]
forall a b. (a -> b) -> a -> b
$ [Statement] -> ViewConfig -> [GeneratorAction]
buildPlan' [Statement]
schema ViewConfig
viewConfig

-- E.g. qualifiedViewModuleName config "Edit" == "Web.View.Users.Edit"
qualifiedViewModuleName :: ViewConfig -> Text -> Text
qualifiedViewModuleName :: ViewConfig -> Text -> Text
qualifiedViewModuleName ViewConfig
config Text
viewName =
    ViewConfig
config.applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".View." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ViewConfig
config.controllerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
viewName

buildPlan' :: [Statement] -> ViewConfig -> [GeneratorAction]
buildPlan' :: [Statement] -> ViewConfig -> [GeneratorAction]
buildPlan' [Statement]
schema ViewConfig
config =
        let
            controllerName :: Text
controllerName = ViewConfig
config.controllerName
            name :: Text
name = ViewConfig
config.viewName
            singularName :: Text
singularName = ViewConfig
config.modelName Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
singularize Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst -- TODO: `singularize` Should Support Lower-Cased Words
            pluralName :: Text
pluralName = Text
singularName Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
pluralize Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst -- TODO: `pluralize` Should Support Lower-Cased Words
            singularVariableName :: Text
singularVariableName = Text -> Text
lcfirst Text
singularName
            pluralVariableName :: Text
pluralVariableName = Text -> Text
lcfirst Text
controllerName
            nameWithSuffix :: Text
nameWithSuffix = if Text
"View" Text -> Text -> Bool
`isSuffixOf` Text
name
                then Text
name
                else Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"View" --e.g. "Test" -> "TestView"
            nameWithoutSuffix :: Text
nameWithoutSuffix = if Text
"View" Text -> Text -> Bool
`isSuffixOf` Text
name
                then HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"View" Text
"" Text
name
                else Text
name --e.g. "TestView" -> "Test"

            indexAction :: Text
indexAction = Text
pluralName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action"
            specialCases :: [(Text, Text)]
specialCases = [
                  (Text
"IndexView", Text
indexView)
                , (Text
"ShowView", Text
showView)
                , (Text
"EditView", Text
editView)
                , (Text
"NewView", Text
newView)
                ]

            paginationEnabled :: Bool
paginationEnabled = ViewConfig
config.paginationEnabled

            modelFields :: [Text]
            modelFields :: [Text]
modelFields =  [ Text -> Text
modelNameToTableName Text
pluralVariableName, Text
pluralVariableName ]
                    [Text] -> ([Text] -> [[Text]]) -> [[Text]]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Maybe [Text]) -> [Text] -> [[Text]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Statement] -> Text -> Maybe [Text]
fieldsForTable [Statement]
schema)
                    [[Text]] -> ([[Text]] -> Maybe [Text]) -> Maybe [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [[Text]] -> Maybe [Text]
forall a. [a] -> Maybe a
head
                    Maybe [Text] -> (Maybe [Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe []

            -- when using the trimming quasiquoter we can't have another |] closure, like for the one we use with hsx.
            qqClose :: Text
qqClose = Text
"|]"

            viewHeader :: Text
viewHeader = [trimming|
                module ${moduleName} where
                import ${applicationName}.View.Prelude
            |]
                where
                    moduleName :: Text
moduleName = ViewConfig -> Text -> Text
qualifiedViewModuleName ViewConfig
config Text
nameWithoutSuffix
                    applicationName :: Text
applicationName = ViewConfig
config.applicationName



            genericView :: Text
genericView = [trimming|
                ${viewHeader}
                data ${nameWithSuffix} = {$nameWithSuffix}

                instance View ${nameWithSuffix} where
                    html ${nameWithSuffix} { .. } = [hsx|
                        {breadcrumb}
                        <h1>${nameWithSuffix}</h1>
                        ${qqClose}
                            where
                                breadcrumb = renderBreadcrumb
                                                [ breadcrumbLink "${pluralizedName}" ${indexAction}
                                                , breadcrumbText "${nameWithSuffix}"
                                                ]
            |]
                where
                    pluralizedName :: Text
pluralizedName = Text -> Text
pluralize Text
name


            showView :: Text
showView = [trimming|
                ${viewHeader}

                data ShowView = ShowView { ${singularVariableName} :: ${singularName} }

                instance View ShowView where
                    html ShowView { .. } = [hsx|
                        {breadcrumb}
                        <h1>Show ${singularName}</h1>
                        <p>{${singularVariableName}}</p>

                    ${qqClose}
                        where
                            breadcrumb = renderBreadcrumb
                                            [ breadcrumbLink "${pluralName}" ${indexAction}
                                            , breadcrumbText "Show ${singularName}"
                                            ]
            |]

            -- The form that will appear in New and Edit pages.
            renderForm :: Text
renderForm = [trimming|
                renderForm :: ${singularName} -> Html
                renderForm ${singularVariableName} = formFor ${singularVariableName} [hsx|
                    ${formFields}
                    {submitButton}

                ${qqClose}
            |]
                where
                    formFields :: Text
formFields =
                        Text -> [Text] -> Text
intercalate Text
"\n" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
field -> Text
"{(textField #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")}") [Text]
modelFields)


            newView :: Text
newView = [trimming|
                ${viewHeader}

                data NewView = NewView { ${singularVariableName} :: ${singularName} }

                instance View NewView where
                    html NewView { .. } = [hsx|
                        {breadcrumb}
                        <h1>New ${singularName}</h1>
                        {renderForm ${singularVariableName}}
                    ${qqClose}
                        where
                            breadcrumb = renderBreadcrumb
                                [ breadcrumbLink "${pluralName}" ${indexAction}
                                , breadcrumbText "New ${singularName}"
                                ]

                ${renderForm}
            |]

            editView :: Text
editView = [trimming|
                ${viewHeader}

                data EditView = EditView { ${singularVariableName} :: ${singularName} }

                instance View EditView where
                    html EditView { .. } = [hsx|
                        {breadcrumb}
                        <h1>Edit ${singularName}</h1>
                        {renderForm ${singularVariableName}}
                    ${qqClose}
                        where
                            breadcrumb = renderBreadcrumb
                                [ breadcrumbLink "${pluralName}" ${indexAction}
                                , breadcrumbText "Edit ${singularName}"
                                ]

                ${renderForm}
            |]

            indexView :: Text
indexView = [trimming|
                ${viewHeader}

                data IndexView = IndexView { ${pluralVariableName} :: [${singularName}]${importPagination} }

                instance View IndexView where
                    html IndexView { .. } = [hsx|
                        {breadcrumb}

                        <h1>${nameWithoutSuffix}<a href={pathTo New${singularName}Action} class="btn btn-primary ms-4">+ New</a></h1>
                        <div class="table-responsive">
                            <table class="table">
                                <thead>
                                    <tr>
                                        <th>${singularName}</th>
                                        <th></th>
                                        <th></th>
                                        <th></th>
                                    </tr>
                                </thead>
                                <tbody>{forEach ${pluralVariableName} render${singularName}}</tbody>
                            </table>
                            ${renderPagination}
                        </div>
                    ${qqClose}
                        where
                            breadcrumb = renderBreadcrumb
                                [ breadcrumbLink "${pluralName}" ${indexAction}
                                ]

                render${singularName} :: ${singularName} -> Html
                render${singularName} ${singularVariableName} = [hsx|
                    <tr>
                        <td>{${singularVariableName}}</td>
                        <td><a href={Show${singularName}Action ${singularVariableName}.id}>Show</a></td>
                        <td><a href={Edit${singularName}Action ${singularVariableName}.id} class="text-muted">Edit</a></td>
                        <td><a href={Delete${singularName}Action ${singularVariableName}.id} class="js-delete text-muted">Delete</a></td>
                    </tr>
                ${qqClose}
            |]
                where
                    importPagination :: Text
importPagination = if Bool
paginationEnabled then Text
", pagination :: Pagination" else Text
""
                    renderPagination :: Text
renderPagination = if Bool
paginationEnabled then Text
"{renderPagination pagination}" else Text
""



            chosenView :: Text
chosenView = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
genericView (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
nameWithSuffix [(Text, Text)]
specialCases)
        in
            [ EnsureDirectory { $sel:directory:CreateFile :: Text
directory = ViewConfig
config.applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/View/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName }
            , CreateFile { $sel:filePath:CreateFile :: Text
filePath = ViewConfig
config.applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/View/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameWithoutSuffix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".hs", $sel:fileContent:CreateFile :: Text
fileContent = Text
chosenView }
            , AddImport { $sel:filePath:CreateFile :: Text
filePath = ViewConfig
config.applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/Controller/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".hs", $sel:fileContent:CreateFile :: Text
fileContent = Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ViewConfig -> Text -> Text
qualifiedViewModuleName ViewConfig
config Text
nameWithoutSuffix }
            ]