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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewConfig -> ViewConfig -> Bool
$c/= :: ViewConfig -> ViewConfig -> Bool
== :: ViewConfig -> ViewConfig -> Bool
$c== :: ViewConfig -> ViewConfig -> Bool
Eq, Int -> ViewConfig -> ShowS
[ViewConfig] -> ShowS
ViewConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewConfig] -> ShowS
$cshowList :: [ViewConfig] -> ShowS
show :: ViewConfig -> String
$cshow :: ViewConfig -> String
showsPrec :: Int -> ViewConfig -> ShowS
$cshowsPrec :: Int -> 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 (forall mono. MonoFoldable mono => mono -> Bool
null Text
viewName Bool -> Bool -> Bool
|| forall mono. MonoFoldable mono => mono -> Bool
null Text
controllerName')
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Left ByteString
parserError -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Right [Statement]
statements -> 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
paginationEnabled :: Bool
controllerName :: Text
modelName :: Text
applicationName :: Text
viewName :: Text
$sel:paginationEnabled:ViewConfig :: Bool
$sel:viewName:ViewConfig :: Text
$sel:modelName:ViewConfig :: Text
$sel:applicationName:ViewConfig :: Text
$sel:controllerName:ViewConfig :: Text
.. }
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right 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 =
    forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "applicationName" a => a
#applicationName ViewConfig
config forall a. Semigroup a => a -> a -> a
<> Text
".View." forall a. Semigroup a => a -> a -> a
<> forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "controllerName" a => a
#controllerName ViewConfig
config forall a. Semigroup a => a -> a -> a
<> 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 = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "controllerName" a => a
#controllerName ViewConfig
config
            name :: Text
name = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "viewName" a => a
#viewName ViewConfig
config
            singularName :: Text
singularName = ViewConfig
config forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "modelName" a => a
#modelName forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
singularize forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst -- TODO: `singularize` Should Support Lower-Cased Words
            pluralName :: Text
pluralName = Text
singularName forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
pluralize 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 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 Text -> Text -> Text -> Text
Text.replace Text
"View" Text
"" Text
name
                else Text
name --e.g. "TestView" -> "Test"

            indexAction :: Text
indexAction = Text
pluralName 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 = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "paginationEnabled" a => a
#paginationEnabled ViewConfig
config

            modelFields :: [Text]
            modelFields :: [Text]
modelFields =  [ Text -> Text
modelNameToTableName Text
pluralVariableName, Text
pluralVariableName ]
                    forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Statement] -> Text -> Maybe [Text]
fieldsForTable [Statement]
schema)
                    forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a. [a] -> Maybe a
head
                    forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> 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 = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "applicationName" a => a
#applicationName ViewConfig
config



            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" (forall a b. (a -> b) -> [a] -> [b]
map (\Text
field -> Text
"{(textField #" forall a. Semigroup a => a -> a -> a
<> Text
field 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 = forall a. a -> Maybe a -> a
fromMaybe Text
genericView (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
nameWithSuffix [(Text, Text)]
specialCases)
        in
            [ EnsureDirectory { $sel:directory:CreateFile :: Text
directory = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "applicationName" a => a
#applicationName ViewConfig
config forall a. Semigroup a => a -> a -> a
<> Text
"/View/" forall a. Semigroup a => a -> a -> a
<> Text
controllerName }
            , CreateFile { $sel:filePath:CreateFile :: Text
filePath = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "applicationName" a => a
#applicationName ViewConfig
config forall a. Semigroup a => a -> a -> a
<> Text
"/View/" forall a. Semigroup a => a -> a -> a
<> Text
controllerName forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
nameWithoutSuffix forall a. Semigroup a => a -> a -> a
<> Text
".hs", $sel:fileContent:CreateFile :: Text
fileContent = Text
chosenView }
            , AddImport { $sel:filePath:CreateFile :: Text
filePath = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "applicationName" a => a
#applicationName ViewConfig
config forall a. Semigroup a => a -> a -> a
<> Text
"/Controller/" forall a. Semigroup a => a -> a -> a
<> Text
controllerName forall a. Semigroup a => a -> a -> a
<> Text
".hs", $sel:fileContent:CreateFile :: Text
fileContent = Text
"import " forall a. Semigroup a => a -> a -> a
<> ViewConfig -> Text -> Text
qualifiedViewModuleName ViewConfig
config Text
nameWithoutSuffix }
            ]